C++InterfacetoTauola
pkorb.f
1 /* copyright(c) 1991-2021 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 
85 C WARNING: Isospin symmetry enforced, cleo or babar were not enforcing it.
86 C Simplification to be used for precision tau decay simulations.
87  BRA1=0.0
88  BRKS=0.0
89 
90 C 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 
97 C Youd better be using korb.dec, NOT decay.dec!!!!
98 C 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 
122 C 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 
146 C Now store mixing parameters for 2pi and 4pi FFs
147 C 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 
186 C amplitudes for curr_cleo.F:
187 C 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
193 C for pi-3pi0: 4pi phase space; rho-pi0pi0
194  PARM(3,36) = 0.
195  PARM(3,37) = 1.0
196 
197 C 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 
213 C The 4pi models are the most complicated in TAUOLA.
214 C If the user has not modified any parameters of the 4pi model,
215 C 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 
234 C 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 
240 C 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 
246 C 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 
252 C 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 
257 C Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
258 C 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 
266 C 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
273 C 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)
278 C C-G coefficients for K1- -> CG1 * |K- pi0> + CG2 * |K0bar pi->
279  CG1 = -SQRT(2./3.)
280  CG2 = SQRT(1./3.)
281 C 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 
298 CAJW 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
301 C 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
315 C 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
Generated on Tue Mar 12 2024 22:57:50 for C++InterfacetoTauola by   doxygen 1.8.7