1/* copyright(c) 1991-2024 free software foundation, inc.
2 this file is part of the gnu c library.
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.
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.
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/>. */
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. */
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. */
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:
41 - 3 additional Zanabazar Square characters */
45C NOTE THAT THE ROUTINES ARE NOT LIKE IN CPC DECK THIS IS HISTORICAL !!
46C=======================================================================
47C====================== DECTES : TEST OF TAU DECAY LIBRARY===========
48C====================== KTORY = 1 : INTERFACE OF KORAL-Z TYPE ==========
49C====================== KTORY = 2 : INTERFACE OF KORAL-B TYPE =========
50C=======================================================================
51C COMMON /PAWC/ BLAN(10000)
52 COMMON / / BLAN(10000)
54 COMMON / INOUT / INUT,IOUT
60 OPEN(IOUT,FILE="./tauola.output")
61 OPEN(INUT,FILE="./dane.dat")
67 SUBROUTINE DECTES(KTORY)
68C ************************
70 DOUBLE PRECISION HH(4)
72 COMMON / JAKI / JAK1,JAK2,JAKP,JAKM,KTOM
75 COMMON / INOUT / INUT,IOUT
76C LUND TYPE IDENTIFIER FOR A1
78C /PTAU/ IS USED IN ROUTINE TRALO4
80 COMMON / TAURAD / XK0DEC,ITDKRC
83C special switch for tests of dGamma/dQ**2 in a1 decay
84C KEYA1=1 constant width of a1 and rho
85C KEYA1=2 free choice of rho propagator (defined in function FPIK)
86C and free choice of a1 mass and width. function g(Q**2)
87C (see formula 3.48 in Comp. Phys. Comm. 64 (1991) 275)
88C hard coded both in Monte Carlo and in testing distribution.
89C KEYA1=3 function g(Q**2) hardcoded in the Monte Carlo
90C (it is timy to calculate!), but appropriately adjusted in
91C testing distribution.
92C-----------------------------------------------------------------------
94C-----------------------------------------------------------------------
95C======================================
103 READ( NINP,3000) TESTIT
104 WRITE(NOUT,3000) TESTIT
105 READ( NINP,3001) KAT1,KAT2,KAT3,KAT4,KAT5,KAT6
106 READ( NINP,3002) NEVT,JAK1,JAK2,ITDKRC
107 READ( NINP,3003) PTAU,XK0DEC
109C======================================
111 WRITE(NOUT,'(6a6/6i6)
')
112 $ 'kat1
','kat2
','kat3
','kat4
','kat5
','kat6
',
113 $ KAT1 , KAT2 , KAT3 , KAT4 , KAT5 , KAT6
114 WRITE(NOUT,'(4a12/4i12)
')
115 $ 'nevt
','jak1
','jak2
','itdkrc
',
116 $ NEVT, JAK1 , JAK2 , ITDKRC
117 WRITE(NOUT,'(2a12/2f12.6)
')
120C======================================
124C LUND IDENTIFIER (FOR TAU+) -15
130C KTO=1 DENOTES TAU DEFINED BY IDFF (I.E. TAU+)
131C KTO=2 DENOTES THE OPPOSITE (I.E. TAU-)
134 PRINT *, 'for the sake of these tests kto has to be 2
'
135 PRINT *, 'to change tau- to tau+ change idff from -15 to 15
'
138C TAU POLARIZATION IN ITS RESTFRAME;
142C TAU MOMENTUM IN GEV;
144C NUMBER OF EVENTS TO BE GENERATED;
147 PRINT *, 'nevtes=
',NEVTES
148 WRITE(IOUT,7011) KEYA1
151 WRITE(IOUT,7001) JAK,IDFF,POL(3),PTAU
153 WRITE(IOUT,7004) JAK,IDFF,POL(3),PTAU
155C INITIALISATION OF TAU DECAY PACKAGE TAUOLA
156C ******************************************
167C-----------------------------------------------------------------------
169C-----------------------------------------------------------------------
173C RESLU INITIALISE THE LUND RECORD
180 CALL DEKAY(KTO+10,HH)
192.EQ.
IF(IPRI1) PRINT *, ' event no:
',NEV,' nevtes:
',NEVTES
195C-----------------------------------------------------------------------
197C-----------------------------------------------------------------------
204 7001 FORMAT(//4(/1X,15(5H=====))
205 $ /,' ', 19X,' test of rad. corr in electron decay
',9X,1H ,
206 $ /,' ', 19X,' tests of tau decay routines
',9X,1H ,
207 $ /,' ', 19X,' INTERFACE of the koral-z
TYPE ',9X,1H ,
208 $ 2(/,1X,15(5H=====)),
209 $ /,5X ,'jak =
',I7 ,' key defining decay
TYPE ',9X,1H ,
210 $ /,5X ,'idff =
',I7 ,' lund identifier for first tau
',9X,1H ,
211 $ /,5X ,'pol(3)=
',F7.2,' third component of tau polariz.
',9X,1H ,
212 $ /,5X ,'ptau =
',F7.2,' third component of tau mom. gev
',9X,1H ,
213 $ 2(/,1X,15(5H=====))/)
214 7002 FORMAT(///1X, '===== event no.
',I4,1X,5H=====)
215 7003 FORMAT(5X,'polarimetric
vector:
',
216 $ 7X,'hh(1)
',7X,'hh(2)
',7X,'hh(3)
',7X,'hh(4)
',
217 $ /, 5X,' ', 4(1X,F11.8) )
218 7004 FORMAT(//4(/1X,15(5H=====))
219 $ /,' ', 19X,' test of rad. corr in electron decay
',9X,1H ,
220 $ /,' ', 19X,' tests of tau decay routines
',9X,1H ,
221 $ /,' ', 19X,' INTERFACE of the koral-b
TYPE ',9X,1H ,
222 $ 2(/,1X,15(5H=====)),
223 $ /,5X ,'jak =
',I7 ,' key defining decay
TYPE ',9X,1H ,
224 $ /,5X ,'idff =
',I7 ,' lund identifier for first tau
',9X,1H ,
225 $ /,5X ,'pol(3)=
',F7.2,' third component of tau polariz.
',9X,1H ,
226 $ /,5X ,'ptau =
',F7.2,' third component of tau mom. gev
',9X,1H ,
227 $ 2(/,1X,15(5H=====))/)
228 7011 FORMAT(///1X, '=====
TYPE of current
',I4,1X,5H=====)
230 SUBROUTINE CHOICE(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
231 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
232 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
233 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
234 * ,AMK,AMKZ,AMKST,GAMKST
236 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
237 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
238 * ,AMK,AMKZ,AMKST,GAMKST
244C XXXXA CORRESPOND TO S2 CHANNEL !
254.EQ.
ELSEIF(MNUM1) THEN
263.EQ.
ELSEIF(MNUM2) THEN
272.EQ.
ELSEIF(MNUM3) THEN
281.EQ.
ELSEIF(MNUM4) THEN
290.EQ.
ELSEIF(MNUM5) THEN
299.EQ.
ELSEIF(MNUM6) THEN
308.EQ.
ELSEIF(MNUM7) THEN
317.EQ.
ELSEIF(MNUM8) THEN
326.EQ.
ELSEIF(MNUM101) THEN
335.EQ.
ELSEIF(MNUM102) THEN
355.LE.
IF (RRPROB1) THEN
357.LE.
ELSEIF(RR(PROB1+PROB2)) THEN
372 PROB3=1.0-PROB1-PROB2
375* ----------------------------------------------------------------------
376* INITIALISATION OF TAU DECAY PARAMETERS and routines
379* ----------------------------------------------------------------------
381 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
382 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
383 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
384 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
385 * ,AMK,AMKZ,AMKST,GAMKST
387 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
388 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
389 * ,AMK,AMKZ,AMKST,GAMKST
390 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
391 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
392 REAL*4 BRA1,BRK0,BRK0B,BRKS
393 PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3)
394 COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE)
396 CHARACTER NAMES(NMODE)*31
397 CHARACTER OLDNAMES(7)*31
400 $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)
'
405* LIST OF BRANCHING RATIOS
406CAM normalised to e nu nutau channel
407CAM enu munu pinu rhonu A1nu Knu K*nu pi
408CAM DATA JLIST / 1, 2, 3, 4, 5, 6, 7,
409*AM DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616
413* conventions of particles names
414* K-,P-,K+, K0,P-,KB, K-,P0,K0
415* 3, 1,-3 , 4, 1,-4 , 3, 2, 4 ,
416* P0,P0,K-, K-,P-,P+, P-,KB,P0
417* 2, 2, 3 , 3, 1,-1 , 1,-4, 2 ,
422 DIMENSION NOPIK(6,NMODE),NPIK(NMODE)
423*AM outgoing multiplicity and flavors of multi-pion /multi-K modes
432 DATA NOPIK / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
433 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
434 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
435 3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
436 4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
437 5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
438 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
439C AJWMOD fix sign bug, 2/22/99
440 7 -3,-4, 0, 0, 0, 0 /
441* LIST OF BRANCHING RATIOS
446.EQ.
IF(I 1) GAMPRT(I) =0.1800
447.EQ.
IF(I 2) GAMPRT(I) =0.1751
448.EQ.
IF(I 3) GAMPRT(I) =0.1110
449.EQ.
IF(I 4) GAMPRT(I) =0.2515
450.EQ.
IF(I 5) GAMPRT(I) =0.1790
451.EQ.
IF(I 6) GAMPRT(I) =0.0071
452.EQ.
IF(I 7) GAMPRT(I) =0.0134
453.EQ.
IF(I 8) GAMPRT(I) =0.0450
454.EQ.
IF(I 9) GAMPRT(I) =0.0100
455.EQ.
IF(I10) GAMPRT(I) =0.0009
456.EQ.
IF(I11) GAMPRT(I) =0.0004
457.EQ.
IF(I12) GAMPRT(I) =0.0003
458.EQ.
IF(I13) GAMPRT(I) =0.0005
459.EQ.
IF(I14) GAMPRT(I) =0.0015
460.EQ.
IF(I15) GAMPRT(I) =0.0015
461.EQ.
IF(I16) GAMPRT(I) =0.0015
462.EQ.
IF(I17) GAMPRT(I) =0.0005
463.EQ.
IF(I18) GAMPRT(I) =0.0050
464.EQ.
IF(I19) GAMPRT(I) =0.0055
465.EQ.
IF(I20) GAMPRT(I) =0.0017
466.EQ.
IF(I21) GAMPRT(I) =0.0013
467.EQ.
IF(I22) GAMPRT(I) =0.0010
468.EQ.
IF(I 1) OLDNAMES(I)=' tau- --> e-
'
469.EQ.
IF(I 2) OLDNAMES(I)=' tau- --> mu-
'
470.EQ.
IF(I 3) OLDNAMES(I)=' tau- --> pi-
'
471.EQ.
IF(I 4) OLDNAMES(I)=' tau- --> pi-, pi0
'
472.EQ.
IF(I 5) OLDNAMES(I)=' tau- --> a1- (two subch)
'
473.EQ.
IF(I 6) OLDNAMES(I)=' tau- --> k-
'
474.EQ.
IF(I 7) OLDNAMES(I)=' tau- --> k*- (two subch)
'
475.EQ.
IF(I 8) NAMES(I-7)=' tau- --> 2pi-, pi0, pi+
'
476.EQ.
IF(I 9) NAMES(I-7)=' tau- --> 3pi0, pi-
'
477.EQ.
IF(I10) NAMES(I-7)=' tau- --> 2pi-, pi+, 2pi0
'
478.EQ.
IF(I11) NAMES(I-7)=' tau- --> 3pi-, 2pi+,
'
479.EQ.
IF(I12) NAMES(I-7)=' tau- --> 3pi-, 2pi+, pi0
'
480.EQ.
IF(I13) NAMES(I-7)=' tau- --> 2pi-, pi+, 3pi0
'
481.EQ.
IF(I14) NAMES(I-7)=' tau- --> k-, pi-, k+
'
482.EQ.
IF(I15) NAMES(I-7)=' tau- --> k0, pi-, k0b
'
483.EQ.
IF(I16) NAMES(I-7)=' tau- --> k-, k0, pi0
'
484.EQ.
IF(I17) NAMES(I-7)=' tau- --> pi0 pi0 k-
'
485.EQ.
IF(I18) NAMES(I-7)=' tau- --> k- pi- pi+
'
486.EQ.
IF(I19) NAMES(I-7)=' tau- --> pi- k0b pi0
'
487.EQ.
IF(I20) NAMES(I-7)=' tau- --> eta pi- pi0
'
488.EQ.
IF(I21) NAMES(I-7)=' tau- --> pi- pi0 gam
'
489.EQ.
IF(I22) NAMES(I-7)=' tau- --> k- k0
'
498 IDFFIN(J,I)=NOPIK(J,I)
503* --- COEFFICIENTS TO FIX RATIO OF:
504* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
505* --- PROBABILITY OF K0 TO BE KS
506* --- PROBABILITY OF K0B TO BE KS
507* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
508* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
509* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
510* --- NEGLECTS MASS-PHASE SPACE EFFECTS
524* ZW 13.04.89 HERE WAS AN ERROR
525 SCABIB = SQRT(1.-CCABIB**2)
527 GAMEL = GFERMI**2*AMTAU**5/(192*PI**3)
533 FUNCTION DCDMAS(IDENT)
534 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
535 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
536 * ,AMK,AMKZ,AMKST,GAMKST
538 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
539 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
540 * ,AMK,AMKZ,AMKST,GAMKST
541.EQ.
IF (IDENT 1) THEN
543.EQ.
ELSEIF (IDENT-1) THEN
545.EQ.
ELSEIF (IDENT 2) THEN
547.EQ.
ELSEIF (IDENT-2) THEN
549.EQ.
ELSEIF (IDENT 3) THEN
551.EQ.
ELSEIF (IDENT-3) THEN
553.EQ.
ELSEIF (IDENT 4) THEN
555.EQ.
ELSEIF (IDENT-4) THEN
557.EQ.
ELSEIF (IDENT 8) THEN
559.EQ.
ELSEIF (IDENT-8) THEN
561.EQ.
ELSEIF (IDENT 9) THEN
563.EQ.
ELSEIF (IDENT-9) THEN
566 PRINT *, 'stop in apkmas, wrong ident=
',IDENT
571 FUNCTION LUNPIK(ID,ISGN)
572 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
573 REAL*4 BRA1,BRK0,BRK0B,BRKS
576.EQ.
IF (IDENT 1) THEN
578.EQ.
ELSEIF (IDENT-1) THEN
580.EQ.
ELSEIF (IDENT 2) THEN
582.EQ.
ELSEIF (IDENT-2) THEN
584.EQ.
ELSEIF (IDENT 3) THEN
586.EQ.
ELSEIF (IDENT-3) THEN
588.EQ.
ELSEIF (IDENT 4) THEN
590* K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
592.GT.
IF (XIO(1)BRK0) THEN
597.EQ.
ELSEIF (IDENT-4) THEN
599* K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
601.GT.
IF (XIO(1)BRK0B) THEN
606.EQ.
ELSEIF (IDENT 8) THEN
608.EQ.
ELSEIF (IDENT-8) THEN
610.EQ.
ELSEIF (IDENT 9) THEN
612.EQ.
ELSEIF (IDENT-9) THEN
615 PRINT *, 'stop in ipkdef, wrong ident=
',IDENT
623 SUBROUTINE TAURDF(KTO)
624C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
625C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
627 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
628 REAL*4 BRA1,BRK0,BRK0B,BRKS
629 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
632C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
639C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
648 SUBROUTINE INIPHY(XK00)
649* ----------------------------------------------------------------------
650* INITIALISATION OF PARAMETERS
651* USED IN QED and/or GSW ROUTINES
652* ----------------------------------------------------------------------
653 COMMON / QEDPRM /ALFINV,ALFPI,XK0
654 REAL*8 ALFINV,ALFPI,XK0
657 PI8 = 4.D0*DATAN(1.D0)
659 ALFPI = 1D0/(ALFINV*PI8)
664C ----------------------------------------------------------------------
665C INITIALISATION OF MASSES
668C ----------------------------------------------------------------------
669 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
670 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
671 * ,AMK,AMKZ,AMKST,GAMKST
673 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
674 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
675 * ,AMK,AMKZ,AMKST,GAMKST
677C IN-COMING / OUT-GOING FERMION MASSES
679C --- let us update tau mass ...
687* MASSES USED IN TAU DECAYS
701C IN-COMING / OUT-GOING FERMION MASSES
702!! AMNUTA = PKORB(1,2)
704!! AMNUMU = PKORB(1,6)
706C MASSES USED IN TAU DECAYS Cleo settings
711 AMA1 = 1.275 !! PKORB(1,10)
712 GAMA1 = 0.615 !! PKORB(2,10)
715!! AMKST = PKORB(1,13)
716!! GAMKST = PKORB(2,13)
723C SUBSITUTE OF tau PRODUCTION GENERATOR
725 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
726 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
727 * ,AMK,AMKZ,AMKST,GAMKST
729 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
730 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
731 * ,AMK,AMKZ,AMKST,GAMKST
733C positions of taus in the LUND common block
734C it will be used by TAUOLA output routines.
735 COMMON /TAUPOS / NPA,NPB
736 DIMENSION XPB1(4),XPB2(4),AQF1(4),AQF2(4)
738C --- DEFINING DUMMY EVENTS MOMENTA
748 CALL TRALO4(1,AQF1,AQF1,AM)
749 CALL TRALO4(2,AQF2,AQF2,AM)
750C --- BEAMS MOMENTA AND IDENTIFIERS
751 KFB1= 11*IDFF/IABS(IDFF)
752 KFB2=-11*IDFF/IABS(IDFF)
756 $ XPB1(3)= AQF1(4)*AQF1(3)/ABS(AQF1(3))
760 $ XPB2(3)= AQF2(4)*AQF2(3)/ABS(AQF2(3))
761C --- Position of first and second tau in LUND common
764C --- FILL TO LUND COMMON
765 CALL FILHEP( 1,3, KFB1,0,0,0,0,XPB1, AMEL,.TRUE.)
766 CALL FILHEP( 2,3, KFB2,0,0,0,0,XPB2, AMEL,.TRUE.)
767 CALL FILHEP(NPA,1, IDFF,1,2,0,0,AQF1,AMTAU,.TRUE.)
768 CALL FILHEP(NPB,1,-IDFF,1,2,0,0,AQF2,AMTAU,.TRUE.)
770 SUBROUTINE TRALO4(KTO,P,Q,AM)
771C **************************
775 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
776 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
777 * ,AMK,AMKZ,AMKST,GAMKST
779 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
780 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
781 * ,AMK,AMKZ,AMKST,GAMKST
784 ETAU=SQRT(PTAU**2+AMTAU**2)
785 EXE=(ETAU+PTAU)/AMTAU
786.EQ.
IF(KTO2) EXE=(ETAU-PTAU)/AMTAU
788C ======================================================================
790C ======================================================================
792 SUBROUTINE FILHEP(N,IST,ID,JMO1,JMO2,JDA1,JDA2,P4,PINV,PHFLAG)
793C ----------------------------------------------------------------------
794C this subroutine fills one entry into the HEPEVT common
795C and updates the information for affected mother entries
797C written by Martin W. Gruenewald (91/01/28)
799C called by : ZTOHEP,BTOHEP,DWLUxy
800C ----------------------------------------------------------------------
802C this is the hepevt class in old style. No d_h_ class pre-name
804 PARAMETER (NMXHEP=10000)
805 REAL*8 phep, vhep ! to be real*4/ *8 depending on host
806 INTEGER nevhep,nhep,isthep,idhep,jmohep,
809 $ nevhep, ! serial number
810 $ nhep, ! number of particles
811 $ isthep(nmxhep), ! status code
812 $ idhep(nmxhep), ! particle ident KF
813 $ jmohep(2,nmxhep), ! parent particles
814 $ jdahep(2,nmxhep), ! childreen particles
815 $ phep(5,nmxhep), ! four-momentum, mass [GeV]
816 $ vhep(4,nmxhep) ! vertex [mm]
817* ----------------------------------------------------------------------
820 $ qedrad(nmxhep) ! Photos flag
821* ----------------------------------------------------------------------
823C PARAMETER (NMXHEP=2000)
824C COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
825C &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
827C COMMON/PHOQED/QEDRAD(NMXHEP)
839.GT.
ELSE IF (N0) THEN
850.LE..OR..GT.
IF ((IHEP0)(IHEPNMXHEP)) RETURN
857.LT.
IF(JMO10)JMOHEP(1,IHEP)=JMOHEP(1,IHEP)+IHEP
859.LT.
IF(JMO20)JMOHEP(2,IHEP)=JMOHEP(2,IHEP)+IHEP
866C KORAL-B and KORAL-Z do not provide vertex and/or lifetime informations
874 DO IP=JMOHEP(1,IHEP),JMOHEP(2,IHEP)
877C if there is a daughter at IHEP, mother entry at IP has decayed
878.EQ.
IF(ISTHEP(IP)1)ISTHEP(IP)=2
880C and daughter pointers of mother entry must be updated
881.EQ.
IF(JDAHEP(1,IP)0)THEN
885 JDAHEP(2,IP)=MAX(IHEP,JDAHEP(2,IP))