*///////////////////////////////////////////////////////////////////////////////////// *// // *// !!!!!!! WARNING!!!!! This source is agressive !!!! // *// // *// Due to short common block names it owerwrites variables in other parts // *// of the code. // *// // *// One should add suffix c_Taul_ to names of all commons as soon as possible!!!! // *// // *///////////////////////////////////////////////////////////////////////////////////// *///////////////////////////////////////////////////////////////////////////////////// *// // *// Standard Tauola interface/initialization routines of functionality exactly // *// as in Tauola CPC but input is partially from xpar(*) matrix // *// ITAUXPAR is for indirect adressing // *// // *///////////////////////////////////////////////////////////////////////////////////// SUBROUTINE INIETC(ITAUXPAR,xpar) INCLUDE "BXformat.h" REAL*8 xpar(*) INTEGER INUT,IOUT COMMON /INOUT/ $ INUT, ! Input unit number (not used) $ IOUT ! Ounput unit number COMMON / IDFC / IDFF COMMON / TAURAD / XK0DEC,ITDKRC DOUBLE PRECISION XK0DEC COMMON / JAKI / JAK1,JAK2,JAKP,JAKM,KTOM * Note: I dont see KeyA1=2,3 realy implemented in the code SJ. ?????? INTEGER KeyA1 COMMON /TESTA1/ $ KeyA1 ! Special switch for tests of dGamma/dQ**2 in a1 decay * KeyA1=1 constant width of a1 and rho * KeyA1=2 free choice of rho propagator (defined in function FPIK) * and free choice of a1 mass and width. function g(Q**2) * (see formula 3.48 in Comp. Phys. Comm. 64 (1991) 275) * hard coded both in Monte Carlo and in testing distribution. * KeyA1=3 function g(Q**2) hardcoded in the Monte Carlo * (it is timy to calculate!), but appropriately adjusted in testing distribution. SAVE idff = xpar(ITAUXPAR+3) ! Lund identifier for first tau (15 for tau-) C XK0 for tau decays. xk0dec = xpar(ITAUXPAR+5) ! IR-cut for QED rad. in leptonic decays C radiative correction switch in tau --> e (mu) decays ! itdkRC = xpar(ITAUXPAR+4) ! QED rad. in leptonic decays C switches of tau+ tau- decay modes !! Jak1 = xpar(ITAUXPAR+1) ! Decay Mask for first tau Jak2 = xpar(ITAUXPAR+2) ! Decay Mask for second tau C output file number for TAUOLA IOUT = xpar(4) C KeyA1 is used for formfactors actually not in use KeyA1 = xpar(ITAUXPAR+6) ! Type of a1 current WRITE(iout,bxope) WRITE(iout,bxtxt) ' Parameters passed from KK to Tauola: ' WRITE(iout,bxl1i) Jak1, 'dec. type 1-st tau ','Jak1 ','t01' WRITE(iout,bxl1i) Jak2, 'dec. type 2-nd tau ','Jak2 ','t02' WRITE(iout,bxl1i) KeyA1, 'current type a1 dec.','KeyA1 ','t03' WRITE(iout,bxl1i) idff, 'PDG id 1-st tau ','idff ','t04' WRITE(iout,bxl1i) itdkRC, 'R.c. switch lept dec','itdkRC','t05' WRITE(iout,bxl1g) xk0dec, 'IR-cut for lept r.c.','xk0dec','t06' WRITE(iout,bxclo) end SUBROUTINE INITDK(ITAUXPAR,xpar) * ---------------------------------------------------------------------- * INITIALISATION OF TAU DECAY PARAMETERS and routines * * called by : KORALZ * ---------------------------------------------------------------------- INCLUDE "BXformat.h" INTEGER INUT,IOUT COMMON /INOUT/ $ INUT, ! Input unit number (not used) $ IOUT ! Ounput unit number REAL*8 xpar(*) COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 * ,AMK,AMKZ,AMKST,GAMKST * REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 * ,AMK,AMKZ,AMKST,GAMKST COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS REAL*4 BRA1,BRK0,BRK0B,BRKS #if defined (ALEPH) PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3) COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE) & ,NAMES CHARACTER NAMES(NMODE)*31 #else PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3) COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE) & ,NAMES CHARACTER NAMES(NMODE)*31 #endif CHARACTER OLDNAMES(7)*31 CHARACTER*80 bxINIT PARAMETER ( $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)' $ ) REAL*4 PI,POL1(4) * * * LIST OF BRANCHING RATIOS CAM normalised to e nu nutau channel CAM enu munu pinu rhonu A1nu Knu K*nu pi CAM DATA JLIST / 1, 2, 3, 4, 5, 6, 7, #if defined (ALEPH) CAM /0.1779,0.1731,0.1106,0.2530,0.1811,0.0072,0.0139 CAM DATA GAMPRT / 1.000,0.9732,0.6217,1.4221,1.0180,0.0405,0.0781 CAM DATA GAMPRT /1.000,0.9676,0.6154,1.3503,1.0225,0.0368,O.O758 CAM C C conventions of particles names c cam mode (JAK) 8 9 CAM channel pi- pi- pi0 pi+ 3pi0 pi- cam particle code -1,-1, 2, 1, 0, 0, 2, 2, 2,-1, 0, 0, CAM BR relative to electron .2414, .0601, c * 10 11 * 1 3pi+- 2pi0 5pi+- * 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0, * 1 .0281, .0045, * 12 13 * 2 5pi+- pi0 3pi+- 3pi0 * 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2, * 2 .0010, .0062, * 14 15 * 3 K- pi- K+ K0 pi- KB * 3 -3,-1, 3, 0, 0, 0, 4,-1,-4, 0, 0, 0, * 3 .0096, .0169, * 16 17 * 4 K- pi0 K0 2pi0 K- * 4 -3, 2, 4, 0, 0, 0, 2, 2,-3, 0, 0, 0, * 4 .0056, .0045, * 18 19 * 5 K- pi- pi+ pi- KB pi0 * 5 -3,-1, 1, 0, 0, 0, -1,-4, 2, 0, 0, 0, * 5 .0219, .0180, * 20 21 * 6 eta pi- pi0 pi- pi0 gamma * 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0, * 6 .0096, .0088, * 22 / * 7 K- K0 / * 7 -3, 4 / * 7 .0146 / #else *AM DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616 *AM *AM multipion decays * * conventions of particles names * K-,P-,K+, K0,P-,KB, K-,P0,K0 * 3, 1,-3 , 4, 1,-4 , 3, 2, 4 , * P0,P0,K-, K-,P-,P+, P-,KB,P0 * 2, 2, 3 , 3, 1,-1 , 1,-4, 2 , * ET,P-,P0 P-,P0,GM * 9, 1, 2 , 1, 2, 8 * #endif C DIMENSION NOPIK(6,NMODE),NPIK(NMODE) *AM outgoing multiplicity and flavors of multi-pion /multi-K modes DATA NPIK / 4, 4, 1 5, 5, 2 6, 6, 3 3, 3, 4 3, 3, 5 3, 3, 6 3, 3, 7 2 / #if defined (ALEPH) DATA NOPIK / -1,-1, 2, 1, 0, 0, 2, 2, 2,-1, 0, 0, 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0, 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2, 3 -3,-1, 3, 0, 0, 0, 4,-1,-4, 0, 0, 0, 4 -3, 2, 4, 0, 0, 0, 2, 2,-3, 0, 0, 0, 5 -3,-1, 1, 0, 0, 0, -1,-4, 2, 0, 0, 0, 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0, #else DATA NOPIK / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0, 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0, 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2, 3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0, 4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0, 5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0, 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0, #endif #if defined (CLEO) C AJWMOD fix sign bug, 2/22/99 7 -3,-4, 0, 0, 0, 0 / #else 7 -3, 4, 0, 0, 0, 0 / #endif * LIST OF BRANCHING RATIOS NCHAN = NMODE + 7 DO 1 I = 1,30 IF (I.LE.NCHAN) THEN JLIST(I) = I #if defined (CePeCe) IF(I.EQ. 1) GAMPRT(I) = 1.0000 IF(I.EQ. 2) GAMPRT(I) = 1.0000 IF(I.EQ. 3) GAMPRT(I) = 1.0000 IF(I.EQ. 4) GAMPRT(I) = 1.0000 IF(I.EQ. 5) GAMPRT(I) = 1.0000 IF(I.EQ. 6) GAMPRT(I) = 1.0000 IF(I.EQ. 7) GAMPRT(I) = 1.0000 IF(I.EQ. 8) GAMPRT(I) = 1.0000 IF(I.EQ. 9) GAMPRT(I) = 1.0000 IF(I.EQ.10) GAMPRT(I) = 1.0000 IF(I.EQ.11) GAMPRT(I) = 1.0000 IF(I.EQ.12) GAMPRT(I) = 1.0000 IF(I.EQ.13) GAMPRT(I) = 1.0000 IF(I.EQ.14) GAMPRT(I) = 1.0000 IF(I.EQ.15) GAMPRT(I) = 1.0000 IF(I.EQ.16) GAMPRT(I) = 1.0000 IF(I.EQ.17) GAMPRT(I) = 1.0000 IF(I.EQ.18) GAMPRT(I) = 1.0000 IF(I.EQ.19) GAMPRT(I) = 1.0000 IF(I.EQ.20) GAMPRT(I) = 1.0000 IF(I.EQ.21) GAMPRT(I) = 1.0000 IF(I.EQ.22) GAMPRT(I) = 1.0000 #elif defined (CLEO) IF(I.EQ. 1) GAMPRT(I) =0.1800 IF(I.EQ. 2) GAMPRT(I) =0.1751 IF(I.EQ. 3) GAMPRT(I) =0.1110 IF(I.EQ. 4) GAMPRT(I) =0.2515 IF(I.EQ. 5) GAMPRT(I) =0.1790 IF(I.EQ. 6) GAMPRT(I) =0.0071 IF(I.EQ. 7) GAMPRT(I) =0.0134 IF(I.EQ. 8) GAMPRT(I) =0.0450 IF(I.EQ. 9) GAMPRT(I) =0.0100 IF(I.EQ.10) GAMPRT(I) =0.0009 IF(I.EQ.11) GAMPRT(I) =0.0004 IF(I.EQ.12) GAMPRT(I) =0.0003 IF(I.EQ.13) GAMPRT(I) =0.0005 IF(I.EQ.14) GAMPRT(I) =0.0015 IF(I.EQ.15) GAMPRT(I) =0.0015 IF(I.EQ.16) GAMPRT(I) =0.0015 IF(I.EQ.17) GAMPRT(I) =0.0005 IF(I.EQ.18) GAMPRT(I) =0.0050 IF(I.EQ.19) GAMPRT(I) =0.0055 IF(I.EQ.20) GAMPRT(I) =0.0017 IF(I.EQ.21) GAMPRT(I) =0.0013 IF(I.EQ.22) GAMPRT(I) =0.0010 #elif defined (ALEPH) IF(I.EQ. 1) GAMPRT(I) = 1.0000 IF(I.EQ. 2) GAMPRT(I) = .9732 IF(I.EQ. 3) GAMPRT(I) = .6217 IF(I.EQ. 4) GAMPRT(I) = 1.4221 IF(I.EQ. 5) GAMPRT(I) = 1.0180 IF(I.EQ. 6) GAMPRT(I) = .0405 IF(I.EQ. 7) GAMPRT(I) = .0781 IF(I.EQ. 8) GAMPRT(I) = .2414 IF(I.EQ. 9) GAMPRT(I) = .0601 IF(I.EQ.10) GAMPRT(I) = .0281 IF(I.EQ.11) GAMPRT(I) = .0045 IF(I.EQ.12) GAMPRT(I) = .0010 IF(I.EQ.13) GAMPRT(I) = .0062 IF(I.EQ.14) GAMPRT(I) = .0096 IF(I.EQ.15) GAMPRT(I) = .0169 IF(I.EQ.16) GAMPRT(I) = .0056 IF(I.EQ.17) GAMPRT(I) = .0045 IF(I.EQ.18) GAMPRT(I) = .0219 IF(I.EQ.19) GAMPRT(I) = .0180 IF(I.EQ.20) GAMPRT(I) = .0096 IF(I.EQ.21) GAMPRT(I) = .0088 IF(I.EQ.22) GAMPRT(I) = .0146 #else #endif IF(I.EQ. 1) OLDNAMES(I)=' TAU- --> E- ' IF(I.EQ. 2) OLDNAMES(I)=' TAU- --> MU- ' IF(I.EQ. 3) OLDNAMES(I)=' TAU- --> PI- ' IF(I.EQ. 4) OLDNAMES(I)=' TAU- --> PI-, PI0 ' IF(I.EQ. 5) OLDNAMES(I)=' TAU- --> A1- (two subch) ' IF(I.EQ. 6) OLDNAMES(I)=' TAU- --> K- ' IF(I.EQ. 7) OLDNAMES(I)=' TAU- --> K*- (two subch) ' IF(I.EQ. 8) NAMES(I-7)=' TAU- --> 2PI-, PI0, PI+ ' IF(I.EQ. 9) NAMES(I-7)=' TAU- --> 3PI0, PI- ' IF(I.EQ.10) NAMES(I-7)=' TAU- --> 2PI-, PI+, 2PI0 ' IF(I.EQ.11) NAMES(I-7)=' TAU- --> 3PI-, 2PI+, ' IF(I.EQ.12) NAMES(I-7)=' TAU- --> 3PI-, 2PI+, PI0 ' IF(I.EQ.13) NAMES(I-7)=' TAU- --> 2PI-, PI+, 3PI0 ' IF(I.EQ.14) NAMES(I-7)=' TAU- --> K-, PI-, K+ ' IF(I.EQ.15) NAMES(I-7)=' TAU- --> K0, PI-, K0B ' #if defined (ALEPH) IF(I.EQ.16) NAMES(I-7)=' TAU- --> K- PI0 K0 ' #else IF(I.EQ.16) NAMES(I-7)=' TAU- --> K-, K0, PI0 ' #endif IF(I.EQ.17) NAMES(I-7)=' TAU- --> PI0 PI0 K- ' IF(I.EQ.18) NAMES(I-7)=' TAU- --> K- PI- PI+ ' IF(I.EQ.19) NAMES(I-7)=' TAU- --> PI- K0B PI0 ' IF(I.EQ.20) NAMES(I-7)=' TAU- --> ETA PI- PI0 ' IF(I.EQ.21) NAMES(I-7)=' TAU- --> PI- PI0 GAM ' IF(I.EQ.22) NAMES(I-7)=' TAU- --> K- K0 ' ELSE JLIST(I) = 0 GAMPRT(I) = 0. ENDIF 1 CONTINUE DO I=1,NMODE MULPIK(I)=NPIK(I) DO J=1,MULPIK(I) IDFFIN(J,I)=NOPIK(J,I) ENDDO ENDDO * * * --- COEFFICIENTS TO FIX RATIO OF: * --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.) * --- PROBABILITY OF K0 TO BE KS * --- PROBABILITY OF K0B TO BE KS * --- RATIO OF COEFFICIENTS FOR K*--> K0 PI- * --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0) * --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE * --- NEGLECTS MASS-PHASE SPACE EFFECTS BRA1=0.5 BRK0=0.5 BRK0B=0.5 BRKS=0.6667 * GFERMI = 1.16637E-5 CCABIB = 0.975 GV = 1.0 GA =-1.0 GFERMI = xpar(32) IF (XPAR(ITAUXPAR+100+1).GT.-1D0) THEN C initialization form KK CCABIB = XPAR(ITAUXPAR+7) GV = XPAR(ITAUXPAR+8) GA = XPAR(ITAUXPAR+9) BRA1 = XPAR(ITAUXPAR+10) BRKS = XPAR(ITAUXPAR+11) BRK0 = XPAR(ITAUXPAR+12) BRK0B = XPAR(ITAUXPAR+13) DO K=1,NCHAN GAMPRT(K)=XPAR(ITAUXPAR+100+K) ENDDO ENDIF * ZW 13.04.89 HERE WAS AN ERROR SCABIB = SQRT(1.-CCABIB**2) PI =4.*ATAN(1.) GAMEL = GFERMI**2*AMTAU**5/(192*PI**3) * * CALL DEXAY(-1,pol1) * * PRINTOUTS FOR KK version SUM=0 DO K=1,NCHAN SUM=SUM+GAMPRT(K) ENDDO WRITE(iout,bxope) WRITE(iout,bxtxt) ' TAUOLA Initialization SUBROUTINE INITDK: ' WRITE(iout,bxtxt) ' Adopted to read from KK ' WRITE(iout,bxtxt) ' ' WRITE(iout,bxtxt) ' Choice Probability -- Decay Channel' DO K=1,7 WRITE(iout,bxINIT) GAMPRT(K)/SUM, OLDNAMES(K),'****','***' ENDDO DO K=8,7+NMODE WRITE(iout,bxINIT) GAMPRT(K)/SUM, NAMES(K-7),'****','***' ENDDO WRITE(iout,bxtxt) ' In addition:' WRITE(iout,bxINIT) GV, 'Vector W-tau-nu coupl. ','****','***' WRITE(iout,bxINIT) GA, 'Axial W-tau-nu coupl. ','****','***' WRITE(iout,bxINIT) GFERMI,'Fermi Coupling ','****','***' WRITE(iout,bxINIT) CCABIB,'cabibo angle ','****','***' WRITE(iout,bxINIT) BRA1, 'a1 br ratio (massless) ','****','***' WRITE(iout,bxINIT) BRKS, 'K* br ratio (massless) ','****','***' WRITE(iout,bxclo) RETURN END SUBROUTINE INIPHY(XK00) * ---------------------------------------------------------------------- * INITIALISATION OF PARAMETERS * USED IN QED and/or GSW ROUTINES * ---------------------------------------------------------------------- COMMON / QEDPRM /ALFINV,ALFPI,XK0 REAL*8 ALFINV,ALFPI,XK0 REAL*8 PI8,XK00 * PI8 = 4.D0*DATAN(1.D0) ALFINV = 137.03604D0 ALFPI = 1D0/(ALFINV*PI8) XK0=XK00 END SUBROUTINE INIMAS(ITAUXPAR,xpar) * ---------------------------------------------------------------------- * INITIALISATION OF MASSES * * called by : KORALZ * ---------------------------------------------------------------------- INCLUDE "BXformat.h" INTEGER INUT,IOUT COMMON /INOUT/ $ INUT, ! Input unit number (not used) $ IOUT ! Ounput unit number REAL*8 xpar(*) COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 * ,AMK,AMKZ,AMKST,GAMKST * REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 * ,AMK,AMKZ,AMKST,GAMKST CHARACTER*80 bxINIT PARAMETER ( $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)' $ ) * * IN-COMING / OUT-GOING FERMION MASSES AMTAU = xpar(656) AMNUTA = 0.010 AMEL = xpar(616) AMNUE = 0.0 AMMU = xpar(636) AMNUMU = 0.0 * * MASSES USED IN TAU DECAYS #if defined (CePeCe) AMPIZ = 0.134964 AMPI = 0.139568 AMRO = 0.773 GAMRO = 0.145 *C GAMRO = 0.666 AMA1 = 1.251 GAMA1 = 0.599 AMK = 0.493667 AMKZ = 0.49772 AMKST = 0.8921 GAMKST = 0.0513 #elif defined (CLEO) AMPIZ = 0.134964 AMPI = 0.139568 AMRO = 0.773 GAMRO = 0.145 *C GAMRO = 0.666 AMA1 = 1.251 GAMA1 = 0.599 AMK = 0.493667 AMKZ = 0.49772 AMKST = 0.8921 GAMKST = 0.0513 C C C IN-COMING / OUT-GOING FERMION MASSES !! AMNUTA = PKORB(1,2) !! AMNUE = PKORB(1,4) !! AMNUMU = PKORB(1,6) C C MASSES USED IN TAU DECAYS Cleo settings !! AMPIZ = PKORB(1,7) !! AMPI = PKORB(1,8) !! AMRO = PKORB(1,9) !! GAMRO = PKORB(2,9) AMA1 = 1.275 !! PKORB(1,10) GAMA1 = 0.615 !! PKORB(2,10) !! AMK = PKORB(1,11) !! AMKZ = PKORB(1,12) !! AMKST = PKORB(1,13) !! GAMKST = PKORB(2,13) C #elif defined (ALEPH) AMPIZ = 0.134964 AMPI = 0.139568 AMRO = 0.7714 GAMRO = 0.153 cam AMRO = 0.773 cam GAMRO = 0.145 AMA1 = 1.251! PMAS(LUCOMP(ia1),1) ! AMA1 = 1.251 GAMA1 = 0.599! PMAS(LUCOMP(ia1),2) ! GAMA1 = 0.599 print *,'INIMAS a1 mass= ',ama1,gama1 AMK = 0.493667 AMKZ = 0.49772 AMKST = 0.8921 GAMKST = 0.0513 #else #endif WRITE(iout,bxope) WRITE(iout,bxtxt) ' TAUOLA Initialization SUBROUTINE INIMAS: ' WRITE(iout,bxtxt) ' Adopted to read from KK ' WRITE(iout,bxINIT) amtau, 'AMTAU tau-mass ','****','***' WRITE(iout,bxINIT) amel , 'AMEL electron-mass ','****','***' WRITE(iout,bxINIT) ammu , 'AMMU muon-mass ','****','***' WRITE(iout,bxclo) END SUBROUTINE CHOICE(MNUM,RR,ICHAN,PROB1,PROB2,PROB3, $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB) COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 * ,AMK,AMKZ,AMKST,GAMKST C REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 * ,AMK,AMKZ,AMKST,GAMKST C AMROP=1.1 GAMROP=0.36 AMOM=.782 GAMOM=0.0084 C XXXXA CORRESPOND TO S2 CHANNEL ! IF(MNUM.EQ.0) THEN PROB1=0.5 PROB2=0.5 AMRX =AMA1 GAMRX=GAMA1 AMRA =AMRO GAMRA=GAMRO AMRB =AMRO GAMRB=GAMRO ELSEIF(MNUM.EQ.1) THEN PROB1=0.5 PROB2=0.5 AMRX =1.57 GAMRX=0.9 AMRB =AMKST GAMRB=GAMKST AMRA =AMRO GAMRA=GAMRO ELSEIF(MNUM.EQ.2) THEN PROB1=0.5 PROB2=0.5 AMRX =1.57 GAMRX=0.9 AMRB =AMKST GAMRB=GAMKST AMRA =AMRO GAMRA=GAMRO ELSEIF(MNUM.EQ.3) THEN PROB1=0.5 PROB2=0.5 AMRX =1.27 GAMRX=0.3 AMRA =AMKST GAMRA=GAMKST AMRB =AMKST GAMRB=GAMKST ELSEIF(MNUM.EQ.4) THEN PROB1=0.5 PROB2=0.5 AMRX =1.27 GAMRX=0.3 AMRA =AMKST GAMRA=GAMKST AMRB =AMKST GAMRB=GAMKST ELSEIF(MNUM.EQ.5) THEN PROB1=0.5 PROB2=0.5 AMRX =1.27 GAMRX=0.3 AMRA =AMKST GAMRA=GAMKST AMRB =AMRO GAMRB=GAMRO ELSEIF(MNUM.EQ.6) THEN PROB1=0.4 PROB2=0.4 AMRX =1.27 GAMRX=0.3 AMRA =AMRO GAMRA=GAMRO AMRB =AMKST GAMRB=GAMKST ELSEIF(MNUM.EQ.7) THEN PROB1=0.0 PROB2=1.0 AMRX =1.27 GAMRX=0.9 AMRA =AMRO GAMRA=GAMRO AMRB =AMRO GAMRB=GAMRO ELSEIF(MNUM.EQ.8) THEN PROB1=0.0 PROB2=1.0 AMRX =AMROP GAMRX=GAMROP AMRB =AMOM GAMRB=GAMOM AMRA =AMRO GAMRA=GAMRO ELSEIF(MNUM.EQ.101) THEN PROB1=.35 PROB2=.35 AMRX =1.2 GAMRX=.46 AMRB =AMOM GAMRB=GAMOM AMRA =AMOM GAMRA=GAMOM ELSEIF(MNUM.EQ.102) THEN PROB1=0.0 PROB2=0.0 AMRX =1.4 GAMRX=.6 AMRB =AMOM GAMRB=GAMOM AMRA =AMOM GAMRA=GAMOM ELSE PROB1=0.0 PROB2=0.0 AMRX =AMA1 GAMRX=GAMA1 AMRA =AMRO GAMRA=GAMRO AMRB =AMRO GAMRB=GAMRO ENDIF C IF (RR.LE.PROB1) THEN ICHAN=1 ELSEIF(RR.LE.(PROB1+PROB2)) THEN ICHAN=2 AX =AMRA GX =GAMRA AMRA =AMRB GAMRA=GAMRB AMRB =AX GAMRB=GX PX =PROB1 PROB1=PROB2 PROB2=PX ELSE ICHAN=3 ENDIF C PROB3=1.0-PROB1-PROB2 END FUNCTION DCDMAS(IDENT) COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 * ,AMK,AMKZ,AMKST,GAMKST * REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 * ,AMK,AMKZ,AMKST,GAMKST IF (IDENT.EQ. 1) THEN APKMAS=AMPI ELSEIF (IDENT.EQ.-1) THEN APKMAS=AMPI ELSEIF (IDENT.EQ. 2) THEN APKMAS=AMPIZ ELSEIF (IDENT.EQ.-2) THEN APKMAS=AMPIZ ELSEIF (IDENT.EQ. 3) THEN APKMAS=AMK ELSEIF (IDENT.EQ.-3) THEN APKMAS=AMK ELSEIF (IDENT.EQ. 4) THEN APKMAS=AMKZ ELSEIF (IDENT.EQ.-4) THEN APKMAS=AMKZ ELSEIF (IDENT.EQ. 8) THEN APKMAS=0.0001 ELSEIF (IDENT.EQ.-8) THEN APKMAS=0.0001 ELSEIF (IDENT.EQ. 9) THEN APKMAS=0.5488 ELSEIF (IDENT.EQ.-9) THEN APKMAS=0.5488 ELSE PRINT *, 'STOP IN APKMAS, WRONG IDENT=',IDENT STOP ENDIF DCDMAS=APKMAS END FUNCTION LUNPIK(ID,ISGN) COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS REAL*4 BRA1,BRK0,BRK0B,BRKS REAL*4 XIO(1) IDENT=ID*ISGN #if defined (ALEPH) IF (IDENT.EQ. 1) THEN IPKDEF= 211 ELSEIF (IDENT.EQ.-1) THEN IPKDEF=-211 ELSEIF (IDENT.EQ. 2) THEN IPKDEF= 111 ELSEIF (IDENT.EQ.-2) THEN IPKDEF= 111 ELSEIF (IDENT.EQ. 3) THEN IPKDEF= 321 ELSEIF (IDENT.EQ.-3) THEN IPKDEF=-321 #else IF (IDENT.EQ. 1) THEN IPKDEF=-211 ELSEIF (IDENT.EQ.-1) THEN IPKDEF= 211 ELSEIF (IDENT.EQ. 2) THEN IPKDEF=111 ELSEIF (IDENT.EQ.-2) THEN IPKDEF=111 ELSEIF (IDENT.EQ. 3) THEN IPKDEF=-321 ELSEIF (IDENT.EQ.-3) THEN IPKDEF= 321 #endif ELSEIF (IDENT.EQ. 4) THEN * * K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1 CALL RANMAR(XIO,1) IF (XIO(1).GT.BRK0) THEN IPKDEF= 130 ELSE IPKDEF= 310 ENDIF ELSEIF (IDENT.EQ.-4) THEN * * K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1 CALL RANMAR(XIO,1) IF (XIO(1).GT.BRK0B) THEN IPKDEF= 130 ELSE IPKDEF= 310 ENDIF ELSEIF (IDENT.EQ. 8) THEN IPKDEF= 22 ELSEIF (IDENT.EQ.-8) THEN IPKDEF= 22 ELSEIF (IDENT.EQ. 9) THEN IPKDEF= 221 ELSEIF (IDENT.EQ.-9) THEN IPKDEF= 221 ELSE PRINT *, 'STOP IN IPKDEF, WRONG IDENT=',IDENT STOP ENDIF LUNPIK=IPKDEF END #if defined (CLEO) SUBROUTINE TAURDF(KTO) C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT C CONTENTS COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS REAL*4 BRA1,BRK0,BRK0B,BRKS COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN IF (KTO.EQ.1) THEN C ================== C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+) BRA1 = PKORB(4,1) BRKS = PKORB(4,3) BRK0 = PKORB(4,5) BRK0B = PKORB(4,6) ELSE C ==== C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+) BRA1 = PKORB(4,2) BRKS = PKORB(4,4) BRK0 = PKORB(4,5) BRK0B = PKORB(4,6) ENDIF C ===== END #else SUBROUTINE TAURDF(KTO) * THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED * IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT * CONTENTS COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS REAL*4 BRA1,BRK0,BRK0B,BRKS COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN IF (KTO.EQ.1) THEN * ================== * LIST OF BRANCHING RATIOS NCHAN = 19 DO 1 I = 1,30 IF (I.LE.NCHAN) THEN JLIST(I) = I IF(I.EQ. 1) GAMPRT(I) = .0000 IF(I.EQ. 2) GAMPRT(I) = .0000 IF(I.EQ. 3) GAMPRT(I) = .0000 IF(I.EQ. 4) GAMPRT(I) = .0000 IF(I.EQ. 5) GAMPRT(I) = .0000 IF(I.EQ. 6) GAMPRT(I) = .0000 IF(I.EQ. 7) GAMPRT(I) = .0000 IF(I.EQ. 8) GAMPRT(I) = 1.0000 IF(I.EQ. 9) GAMPRT(I) = 1.0000 IF(I.EQ.10) GAMPRT(I) = 1.0000 IF(I.EQ.11) GAMPRT(I) = 1.0000 IF(I.EQ.12) GAMPRT(I) = 1.0000 IF(I.EQ.13) GAMPRT(I) = 1.0000 IF(I.EQ.14) GAMPRT(I) = 1.0000 IF(I.EQ.15) GAMPRT(I) = 1.0000 IF(I.EQ.16) GAMPRT(I) = 1.0000 IF(I.EQ.17) GAMPRT(I) = 1.0000 IF(I.EQ.18) GAMPRT(I) = 1.0000 IF(I.EQ.19) GAMPRT(I) = 1.0000 ELSE JLIST(I) = 0 GAMPRT(I) = 0. ENDIF 1 CONTINUE * --- COEFFICIENTS TO FIX RATIO OF: * --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.) * --- PROBABILITY OF K0 TO BE KS * --- PROBABILITY OF K0B TO BE KS * --- RATIO OF COEFFICIENTS FOR K*--> K0 PI- * --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0) * --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE * --- NEGLECTS MASS-PHASE SPACE EFFECTS BRA1=0.5 BRK0=0.5 BRK0B=0.5 BRKS=0.6667 ELSE * ==== * LIST OF BRANCHING RATIOS NCHAN = 19 DO 2 I = 1,30 IF (I.LE.NCHAN) THEN JLIST(I) = I IF(I.EQ. 1) GAMPRT(I) = .0000 IF(I.EQ. 2) GAMPRT(I) = .0000 IF(I.EQ. 3) GAMPRT(I) = .0000 IF(I.EQ. 4) GAMPRT(I) = .0000 IF(I.EQ. 5) GAMPRT(I) = .0000 IF(I.EQ. 6) GAMPRT(I) = .0000 IF(I.EQ. 7) GAMPRT(I) = .0000 IF(I.EQ. 8) GAMPRT(I) = 1.0000 IF(I.EQ. 9) GAMPRT(I) = 1.0000 IF(I.EQ.10) GAMPRT(I) = 1.0000 IF(I.EQ.11) GAMPRT(I) = 1.0000 IF(I.EQ.12) GAMPRT(I) = 1.0000 IF(I.EQ.13) GAMPRT(I) = 1.0000 IF(I.EQ.14) GAMPRT(I) = 1.0000 IF(I.EQ.15) GAMPRT(I) = 1.0000 IF(I.EQ.16) GAMPRT(I) = 1.0000 IF(I.EQ.17) GAMPRT(I) = 1.0000 IF(I.EQ.18) GAMPRT(I) = 1.0000 IF(I.EQ.19) GAMPRT(I) = 1.0000 ELSE JLIST(I) = 0 GAMPRT(I) = 0. ENDIF 2 CONTINUE * --- COEFFICIENTS TO FIX RATIO OF: * --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.) * --- PROBABILITY OF K0 TO BE KS * --- PROBABILITY OF K0B TO BE KS * --- RATIO OF COEFFICIENTS FOR K*--> K0 PI- * --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0) * --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE * --- NEGLECTS MASS-PHASE SPACE EFFECTS BRA1=0.5 BRK0=0.5 BRK0B=0.5 BRKS=0.6667 ENDIF * ===== END #endif