C++ Interface to Tauola
tauola-F/prod/pkorb.f
1/* copyright(c) 1991-2024 free software foundation, inc.
2 this file is part of the gnu c library.
3
4 the gnu c library is free software; you can redistribute it and/or
5 modify it under the terms of the gnu lesser general Public
6 license as published by the free software foundation; either
7 version 2.1 of the license, or(at your option) any later version.
8
9 the gnu c library is distributed in the hope that it will be useful,
10 but without any warranty; without even the implied warranty of
11 merchantability or fitness for a particular purpose. see the gnu
12 lesser general Public license for more details.
13
14 you should have received a copy of the gnu lesser general Public
15 license along with the gnu c library; if not, see
16 <https://www.gnu.org/licenses/>. */
17
18
19/* this header is separate from features.h so that the compiler can
20 include it implicitly at the start of every compilation. it must
21 not itself include <features.h> or any other header that includes
22 <features.h> because the implicit include comes before any feature
23 test macros that may be defined in a source file before it first
24 explicitly includes a system header. gcc knows the name of this
25 header in order to preinclude it. */
26
27/* glibc's intent is to support the IEC 559 math functionality, real
28 and complex. If the GCC (4.9 and later) predefined macros
29 specifying compiler intent are available, use them to determine
30 whether the overall intent is to support these features; otherwise,
31 presume an older compiler has intent to support these features and
32 define these macros by default. */
33
34
35
36/* wchar_t uses Unicode 10.0.0. Version 10.0 of the Unicode Standard is
37 synchronized with ISO/IEC 10646:2017, fifth edition, plus
38 the following additions from Amendment 1 to the fifth edition:
39 - 56 emoji characters
40 - 285 hentaigana
41 - 3 additional Zanabazar Square characters */
42
43 REAL FUNCTION PKORB(IF1,IF2)
44**********************************************************************
45*
46* This function returns a real value
47* needed in the 1 version of KORALB/TAUOLA
48* corresponding to a mass, width, mixing amplitude, or branching fraction
49* depending on whether IF1 = 1, 2, 3, 4 respectively.
50* The idea is to make minimal mods to the 3-rd party KORALB/TAUOLA code,
51* so this function supplies all the 1-specific parameters.
52*
53* Alan Weinstein, ajw, 11/97
54**********************************************************************
55
56* Arguments:
57 INTEGER IF1 ! input, flag for type of data required
58 INTEGER IF2 ! input, flag for type of data required
59
60* MC info
61*#include "seq/clinc/qqpars.inc"
62*#include "seq/clinc/qqprop.inc"
63*#include "qqlib/seq/qqbrat.inc"
64
65 INTEGER JAK1,JAK2,JAKP,JAKM,KTOM
66 COMMON / JAKI / JAK1,JAK2,JAKP,JAKM,KTOM
67 REAL*4 RRR(1)
68 REAL PARM(4,100)
69 integer imixpp(300)
70 INTEGER INIT,I,J
71 REAL C1270,C1402,A1270_KSPI,A1270_KRHO,A1402_KSPI,A1402_KRHO
72 REAL CG1,CG2,R,BRA1,BRKS
73 SAVE INIT,PARM
74 DATA INIT/0/
75
76**********************************************************************
77* Initialize return variable:
78 PKORB = 0.
79
80**********************************************************************
81* Initialize:
82.EQ. IF (INIT0) THEN
83 INIT = 1
84
85C WARNING: Isospin symmetry enforced, cleo or babar were not enforcing it.
86C Simplification to be used for precision tau decay simulations.
87 BRA1=0.0
88 BRKS=0.0
89
90C CALL VZERO(PARM,400)
91 DO I=1,4
92 DO J=1,100
93 PARM(I,J) = 0
94 END DO
95 END DO
96
97C Youd better be using korb.dec, NOT decay.dec!!!!
98C masses (needed in dist/inimas, formf/form*, etc)
99 PARM(1, 1) = 1.777000 ! TAU
100 PARM(1, 2) = 0. ! NUTA
101 PARM(1, 3) = 0.000511 ! EL
102 PARM(1, 4) = 0. ! NUEL
103 PARM(1, 5) = 0.105658 ! MU
104 PARM(1, 6) = 0. ! NUMU
105 PARM(1, 7) = 0.134976 ! PIZ
106 PARM(1, 8) = 0.139570 ! PI+
107 PARM(1, 9) = 0.769900 ! RHO+
108 PARM(1,10) = 1.275000 ! A1+
109 PARM(1,11) = 0.493677 ! K+
110 PARM(1,12) = 0.497670 ! KZ
111 PARM(1,13) = 0.891590 ! K*+
112 PARM(1,14) = 0.781940 ! OMEG
113 PARM(1,15) = 1.370000 ! RHOP+
114 PARM(1,16) = 1.700000 ! K*P+
115 PARM(1,17) = 1.461000 ! A1P+
116 PARM(1,18) = 1.300000 ! PIP+
117 PARM(1,19) = 1.270000 ! K1A+
118 PARM(1,20) = 1.402000 ! K1B+
119 PARM(1,21) = 1.465000 ! RHOPP+
120 PARM(1,22) = 1.700000 ! RHOPPP+
121
122C widths (needed in dist/inimas, formf/form*, etc)
123 PARM(2, 1) = 0. ! TAU
124 PARM(2, 2) = 0. ! NUTA
125 PARM(2, 3) = 0. ! EL
126 PARM(2, 4) = 0. ! NUEL
127 PARM(2, 5) = 0. ! MU
128 PARM(2, 6) = 0. ! NUMU
129 PARM(2, 7) = 0. ! PIZ
130 PARM(2, 8) = 0. ! PI+
131 PARM(2, 9) = 0.1512 ! RHO+
132 PARM(2,10) = 0.700 ! A1+
133 PARM(2,11) = 0. ! K+
134 PARM(2,12) = 0. ! KZ
135 PARM(2,13) = 0.0498 ! K*+
136 PARM(2,14) = 0.00843 ! OMEG
137 PARM(2,15) = 0.510 ! RHOP+
138 PARM(2,16) = 0.235 ! K*P+
139 PARM(2,17) = 0.250 ! A1P+
140 PARM(2,18) = 0.400 ! PIP+
141 PARM(2,19) = 0.090 ! K1A+
142 PARM(2,20) = 0.174 ! K1B+
143 PARM(2,21) = 0.310 ! RHOPP+
144 PARM(2,22) = 0.235 ! RHOPPP+
145
146C Now store mixing parameters for 2pi and 4pi FFs
147C needed in tauola/fpik, tauola/bwigs, formf/form* , formf/curr :
148
149 PARM(3,15) = -0.145
150
151 IMIXPP(205)=1
152 IMIXPP(207)=1
153 IMIXPP(209)=1
154 IMIXPP(211)=1
155 IMIXPP(201)=1
156 IMIXPP(203)=1
157 IMIXPP(213)=1
158 IMIXPP(215)=1
159
160
161.NE. IF (IMIXPP(205)0) PARM(3,15) = -0.110
162.NE. IF (IMIXPP(207)0) PARM(3,16) = -0.038
163.NE. IF (IMIXPP(209)0) PARM(3,17) = 0.00
164.NE. IF (IMIXPP(211)0) PARM(3,18) = 0.00
165.NE. IF (IMIXPP(201)0) PARM(3,19) = 1.0
166.NE. IF (IMIXPP(203)0) PARM(3,20) = 0.8
167.NE. IF (IMIXPP(213)0) PARM(3,21) = -0.110
168.NE. IF (IMIXPP(215)0) PARM(3,22) = -0.110
169
170 PRINT *,' korb: rho/rhop -> pi-pi0 mixing:'
171 PRINT *,' korb: rho =',PARM(1,9) ,PARM(2,9)
172 PRINT *,' korb: rhop =',PARM(1,15),PARM(2,15),PARM(3,15)
173 PRINT *,' korb: k*/k*prime -> kpi mixing:'
174 PRINT *,' korb: kstp =',PARM(1,16),PARM(2,16),PARM(3,16)
175 PRINT *,' korb: a1/a1prime -> 3pi, kkpi mixing:'
176 PRINT *,' korb: a1 =',PARM(1,10),PARM(2,10)
177 PRINT *,' korb: a1prim=',PARM(1,17),PARM(2,17),PARM(3,17)
178 PRINT *,' korb: k1a/k1b -> kpipi mixing:'
179 PRINT *,' korb: k1a =',PARM(1,19),PARM(2,19),PARM(3,19)
180 PRINT *,' korb: k1b =',PARM(1,20),PARM(2,20),PARM(3,20)
181 PRINT *,' korb: rho/rhop/rhopp -> 4pi mixing:'
182 PRINT *,' korb: rho =',PARM(1,9) ,PARM(2,9)
183 PRINT *,' korb: rhopp =',PARM(1,21),PARM(2,21),PARM(3,21)
184 PRINT *,' korb: rhoppp=',PARM(1,22),PARM(2,22),PARM(3,22)
185
186C amplitudes for curr_cleo.F:
187C for (3pi)-pi0: 4pi phase space; rho0pi-pi0; rho-pi+pi-; rho+pi-pi-; pi-omega
188 PARM(3,31) = 0.
189 PARM(3,32) = 0.1242
190 PARM(3,33) = 0.1604
191 PARM(3,34) = 0.2711
192 PARM(3,35) = 0.4443
193C for pi-3pi0: 4pi phase space; rho-pi0pi0
194 PARM(3,36) = 0.
195 PARM(3,37) = 1.0
196
197C Modify amplitudes for 4pi form-factor in formf/curr, from korb.dec:
198.EQ.CCC IF (IPLIST(2,282)5) THEN
199 IPLIST=0
200.EQ. IF (IPLIST5) THEN
201 PARM(3,31) = 0.0000
202 PARM(3,32) = 0.1242
203 PARM(3,33) = 0.1604
204 PARM(3,34) = 0.2711
205 PARM(3,35) = 0.4443
206 PARM(3,36) = 0.0000
207 PARM(3,37) = 1.0000
208 END IF
209
210 PRINT *,' korb: 3pi-pi0 params:',(PARM(3,I),I=31,35)
211 PRINT *,' korb: pi-3pi0 params:',(PARM(3,I),I=36,37)
212
213C The 4pi models are the most complicated in TAUOLA.
214C If the user has not modified any parameters of the 4pi model,
215C we can use the WTMAX determined with many trials.
216.GT..OR. IF (ABS(PARM(3,31)-0.0000)0.0001
217.GT..OR. 1 ABS(PARM(3,32)-0.1242)0.0001
218.GT..OR. 1 ABS(PARM(3,33)-0.1604)0.0001
219.GT..OR. 1 ABS(PARM(3,34)-0.2711)0.0001
220.GT. 1 ABS(PARM(3,35)-0.4443)0.0001 ) THEN
221 PARM(3,38) = -1.
222 ELSE
223 PARM(3,38) = 6.9673671E-14
224 END IF
225
226.GT..OR. IF (ABS(PARM(3,36)-0.0000)0.0001
227.GT. 1 ABS(PARM(3,37)-1.0000)0.0001 ) THEN
228 PARM(3,39) = -1.
229 ELSE
230 PARM(3,39) = 3.5374880E-13
231 END IF
232
233
234C phases for curr_cleo.F:
235 PARM(3,42) = -0.40
236 PARM(3,43) = 0.00
237 PARM(3,44) = -0.20+3.1416
238 PARM(3,45) = -1.50
239
240C rho' contributions to rho' -> pi-omega:
241 PARM(3,51) = -0.10
242 PARM(3,52) = 1.00
243 PARM(3,53) = -0.10
244 PARM(3,54) = -0.04
245
246C rho' contribtions to rho' -> rhopipi:
247 PARM(3,55) = 1.00
248 PARM(3,56) = 0.14
249 PARM(3,57) = -0.05
250 PARM(3,58) = -0.05
251
252C rho contributions to rhopipi, rho -> 2pi:
253 PARM(3,59) = 1.000
254 PARM(3,60) = -0.145
255 PARM(3,61) = 0.000
256
257C Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
258C needed in dist/taurdf:
259 PARM(4,1) = 0.4920 ! BRA1+
260 PARM(4,2) = 0.4920 ! BRA1-
261 PARM(4,3) = 0.6660 ! BRKS+
262 PARM(4,4) = 0.6660 ! BRKS-
263 PARM(4,5) = 0.5 ! BRK0
264 PARM(4,6) = 0.5 ! BRK0B
265
266C amplitude coefficients for tau -> K1(1270) / K1(1402)
267 C1270 = PARM(3,19)
268 C1402 = PARM(3,20)
269.EQ..AND..EQ. IF (C12700C14020.) THEN
270 C1270 = 1.
271 C1402 = 0.6
272 END IF
273C From PDG96, square roots of branching fractions:
274 A1270_KSPI = SQRT(0.16)
275 A1270_KRHO = SQRT(0.42)
276 A1402_KSPI = SQRT(0.94)
277 A1402_KRHO = SQRT(0.03)
278C C-G coefficients for K1- -> CG1 * |K- pi0> + CG2 * |K0bar pi->
279 CG1 = -SQRT(2./3.)
280 CG2 = SQRT(1./3.)
281C and the resulting amplitudes (times normalized FF):
282 PARM(3,81) = C1270*A1270_KSPI*CG1 ! K1270 -> K*0B pi-
283 PARM(3,82) = C1402*A1402_KSPI*CG1 ! K1402 -> K*0B pi-
284 PARM(3,83) = C1270*A1270_KRHO*CG1 ! K1270 -> K0B rho-
285 PARM(3,84) = C1402*A1402_KRHO*CG1 ! K1402 -> K0B rho-
286 PARM(3,85) = C1270*A1270_KSPI*CG2 ! K1270 -> K*- pi0
287 PARM(3,86) = C1402*A1402_KSPI*CG2 ! K1402 -> K*- pi0
288 PARM(3,87) = C1270*A1270_KRHO*CG2 ! K1270 -> K- rho0
289 PARM(3,88) = C1402*A1402_KRHO*CG2 ! K1402 -> K- rho0
290
291 END IF
292**********************************************************************
293
294 R = 0.
295.GE..AND..LE..AND..GE..AND..LE. IF (IF11 IF14 IF21 IF2100) THEN
296 R = PARM(IF1,IF2)
297
298CAJW 4/4/94 Better to decide on A1 br now, avoid DADMAA/DPHSAA problem.
299.EQ..AND..EQ. IF (IF14JAK15) THEN
300.EQ. IF (IF211) THEN
301C Return the BR used in the last call:
302 R = BRA1
303.EQ. ELSE IF (IF21) THEN
304 BRA1 = R
305 CALL RANMAR(RRR,1)
306.LT. IF (RRR(1)BRA1) THEN
307 R = 1. ! 3pi
308 ELSE
309 R = 0. ! pi-2pi0
310 END IF
311 BRA1 = R
312 END IF
313.EQ..AND..EQ. ELSEIF (IF14JAK17) THEN
314.EQ. IF (IF213) THEN
315C Return the BR used in the last call:
316 R = BRKS
317.EQ. ELSE IF (IF23) THEN
318 BRKS = R
319 CALL RANMAR(RRR,1)
320.LT. IF (RRR(1)BRKS) THEN
321 R = 1. ! K0 pi-
322 ELSE
323 R = 0. ! K- pi0
324 END IF
325 BRKS = R
326 END IF
327 END IF
328
329 END IF
330
331 PKORB = R
332 RETURN
333 END