/* Copyright (C) 1991-2012 Free Software Foundation, Inc. This file is part of the GNU C Library. The GNU C Library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. The GNU C Library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with the GNU C Library; if not, see . */ /* This header is separate from features.h so that the compiler can include it implicitly at the start of every compilation. It must not itself include or any other header that includes because the implicit include comes before any feature test macros that may be defined in a source file before it first explicitly includes a system header. GCC knows the name of this header in order to preinclude it. */ /* We do support the IEC 559 math functionality, real and complex. */ /* wchar_t uses ISO/IEC 10646 (2nd ed., published 2011-03-15) / Unicode 6.0. */ /* We do not support C11 . */ *///////////////////////////////////////////////////////////////////////////////////// *// // *// !!!!!!! 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 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 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, *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 * 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 / 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, C AJWMOD fix sign bug, 2/22/99 7 -3,-4, 0, 0, 0, 0 / * LIST OF BRANCHING RATIOS NCHAN = NMODE + 7 DO 1 I = 1,30 IF (I.LE.NCHAN) THEN JLIST(I) = I 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 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(I.EQ.16) NAMES(I-7)=' TAU- --> K-, K0, PI0 ' 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 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 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 (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 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 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