tauola-F/jetset-F/tauola_photos_ini.f

00001 
00002 
00003 C this file is created by hand from taumain.F
00004 C actions: Remove routines: TAUDEM DECTES TAUFIL FILHEP
00005 C add:     INIETC will not necesarily work fine ... 
00006 C replace  TRALO4 
00007 C rename INIPHY to INIPHX
00008 
00009       SUBROUTINE INIETC(jakk1,jakk2,itd,ifpho)
00010       COMMON / IDFC  / IDFF
00011       COMMON / TAURAD / XK0DEC,ITDKRC
00012       DOUBLE PRECISION            XK0DEC
00013       COMMON / JAKI   /  JAK1,JAK2,JAKP,JAKM,KTOM
00014       COMMON /PHOACT/ IFPHOT
00015       SAVE
00016 C KTO=1 will denote tau+, thus :: IDFF=-15
00017           IDFF=-15
00018 C XK0 for tau decays.
00019           XK0DEC=0.01
00020 C radiative correction switch in tau --> e (mu) decays !
00021           ITDKRC=itd
00022 C switches of tau+ tau- decay modes !!
00023           JAK1=jakk1
00024           JAK2=jakk2
00025 C photos activation switch
00026           IFPHOT=IFPHO
00027       end
00028 
00029       SUBROUTINE TRALO4(KTOS,PHOI,PHOF,AM)
00030 !! Corrected 11.10.96 (ZW) tralor for KORALW.
00031 !! better treatment is to  cascade from tau rest-frame through W
00032 !! restframe down to LAB. 
00033       COMMON / MOMDEC / Q1,Q2,P1,P2,P3,P4
00034       COMMON /TRALID/ idtra
00035       double precision Q1(4),Q2(4),P1(4),P2(4),P3(4),P4(4),P1QQ(4),P2QQ(4)
00036       double precision PIN(4),POUT(4),PBST(4),PBS1(4),QQ(4),PI
00037       double precision THET,PHI,EXE
00038       REAL*4 PHOI(4),PHOF(4)
00039       SAVE
00040       DATA PI /3.141592653589793238462643D0/
00041       AM=SQRT(ABS
00042      $   (PHOI(4)**2-PHOI(3)**2-PHOI(2)**2-PHOI(1)**2))
00043       idtra=KTOS
00044       DO K=1,4
00045        PIN(K)=PHOI(K)
00046        PHOF(K)=PHOI(K)
00047       ENDDO
00048 !      write(*,*) idtra
00049       IF    (idtra.EQ.1) THEN
00050         DO K=1,4
00051          PBST(K)=P1(K)
00052          QQ(K)=Q1(K)
00053         ENDDO
00054       ELSEIF(idtra.EQ.2) THEN
00055         DO K=1,4
00056          PBST(K)=P2(K)
00057          QQ(K)=Q1(K)
00058         ENDDO
00059       ELSEIF(idtra.EQ.3) THEN
00060         DO K=1,4
00061          PBST(K)=P3(K)
00062          QQ(K)=Q2(K)
00063         ENDDO
00064       ELSE
00065         DO K=1,4
00066          PBST(K)=P4(K)
00067          QQ(K)=Q2(K)
00068         ENDDO
00069       ENDIF
00070 
00071 
00072 
00073         CALL BOSTDQ(1,QQ,PBST,PBST)
00074         CALL BOSTDQ(1,QQ,P1,P1QQ)
00075         CALL BOSTDQ(1,QQ,P2,P2QQ)
00076         PBS1(4)=PBST(4)
00077         PBS1(3)=SQRT(PBST(3)**2+PBST(2)**2+PBST(1)**2)
00078         PBS1(2)=0D0
00079         PBS1(1)=0D0 
00080         EXE=(PBS1(4)+PBS1(3))/DSQRT(PBS1(4)**2-PBS1(3)**2)
00081 C for KTOS=1 boost is antiparallel to 4-momentum of P2. 
00082 C restframes of tau+ tau- and 'first' frame of 'higgs' are all connected
00083 C by boosts along z axis
00084        IF(KTOS.EQ.1)  EXE=(PBS1(4)-PBS1(3))/DSQRT(PBS1(4)**2-PBS1(3)**2)
00085         CALL BOSTD3(EXE,PIN,POUT)
00086 
00087 C once in Z/gamma/Higgs rest frame we control further kinematics by P2QQ for KTOS=1,2
00088         THET=ACOS(P2QQ(3)/SQRT(P2QQ(3)**2+P2QQ(2)**2+P2QQ(1)**2))
00089         PHI=0D0
00090         PHI=ACOS(P2QQ(1)/SQRT(P2QQ(2)**2+P2QQ(1)**2))
00091         IF(P2QQ(2).LT.0D0) PHI=2*PI-PHI
00092 
00093         CALL ROTPOX(THET,PHI,POUT)
00094         CALL BOSTDQ(-1,QQ,POUT,POUT)
00095       DO K=1,4
00096        PHOF(K)=POUT(K)
00097       ENDDO
00098       END
00099 
00100 
00101       SUBROUTINE CHOICE(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
00102      $            AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
00103       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00104      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00105      *                 ,AMK,AMKZ,AMKST,GAMKST
00106 C
00107       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00108      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00109      *                 ,AMK,AMKZ,AMKST,GAMKST
00110 C
00111       AMROP=1.1
00112       GAMROP=0.36
00113       AMOM=.782
00114       GAMOM=0.0084
00115 C     XXXXA CORRESPOND TO S2 CHANNEL !
00116       IF(MNUM.EQ.0) THEN
00117        PROB1=0.5
00118        PROB2=0.5
00119        AMRX =AMA1
00120        GAMRX=GAMA1
00121        AMRA =AMRO
00122        GAMRA=GAMRO
00123        AMRB =AMRO
00124        GAMRB=GAMRO
00125       ELSEIF(MNUM.EQ.1) THEN
00126        PROB1=0.5
00127        PROB2=0.5
00128        AMRX =1.57
00129        GAMRX=0.9
00130        AMRB =AMKST
00131        GAMRB=GAMKST
00132        AMRA =AMRO
00133        GAMRA=GAMRO
00134       ELSEIF(MNUM.EQ.2) THEN
00135        PROB1=0.5
00136        PROB2=0.5
00137        AMRX =1.57
00138        GAMRX=0.9
00139        AMRB =AMKST
00140        GAMRB=GAMKST
00141        AMRA =AMRO
00142        GAMRA=GAMRO
00143       ELSEIF(MNUM.EQ.3) THEN
00144        PROB1=0.5
00145        PROB2=0.5
00146        AMRX =1.27
00147        GAMRX=0.3
00148        AMRA =AMKST
00149        GAMRA=GAMKST
00150        AMRB =AMKST
00151        GAMRB=GAMKST
00152       ELSEIF(MNUM.EQ.4) THEN
00153        PROB1=0.5
00154        PROB2=0.5
00155        AMRX =1.27
00156        GAMRX=0.3
00157        AMRA =AMKST
00158        GAMRA=GAMKST
00159        AMRB =AMKST
00160        GAMRB=GAMKST
00161       ELSEIF(MNUM.EQ.5) THEN
00162        PROB1=0.5
00163        PROB2=0.5
00164        AMRX =1.27
00165        GAMRX=0.3
00166        AMRA =AMKST
00167        GAMRA=GAMKST
00168        AMRB =AMRO
00169        GAMRB=GAMRO
00170       ELSEIF(MNUM.EQ.6) THEN
00171        PROB1=0.4
00172        PROB2=0.4
00173        AMRX =1.27
00174        GAMRX=0.3
00175        AMRA =AMRO
00176        GAMRA=GAMRO
00177        AMRB =AMKST
00178        GAMRB=GAMKST
00179       ELSEIF(MNUM.EQ.7) THEN
00180        PROB1=0.0
00181        PROB2=1.0
00182        AMRX =1.27
00183        GAMRX=0.9
00184        AMRA =AMRO
00185        GAMRA=GAMRO
00186        AMRB =AMRO
00187        GAMRB=GAMRO
00188       ELSEIF(MNUM.EQ.8) THEN
00189        PROB1=0.0
00190        PROB2=1.0
00191        AMRX =AMROP
00192        GAMRX=GAMROP
00193        AMRB =AMOM
00194        GAMRB=GAMOM
00195        AMRA =AMRO
00196        GAMRA=GAMRO
00197       ELSEIF(MNUM.EQ.101) THEN
00198        PROB1=.35
00199        PROB2=.35
00200        AMRX =1.2
00201        GAMRX=.46
00202        AMRB =AMOM
00203        GAMRB=GAMOM
00204        AMRA =AMOM
00205        GAMRA=GAMOM
00206       ELSEIF(MNUM.EQ.102) THEN
00207        PROB1=0.0
00208        PROB2=0.0
00209        AMRX =1.4
00210        GAMRX=.6
00211        AMRB =AMOM
00212        GAMRB=GAMOM
00213        AMRA =AMOM
00214        GAMRA=GAMOM
00215       ELSE
00216        PROB1=0.0
00217        PROB2=0.0
00218        AMRX =AMA1
00219        GAMRX=GAMA1
00220        AMRA =AMRO
00221        GAMRA=GAMRO
00222        AMRB =AMRO
00223        GAMRB=GAMRO
00224       ENDIF
00225 C
00226       IF    (RR.LE.PROB1) THEN
00227        ICHAN=1
00228       ELSEIF(RR.LE.(PROB1+PROB2)) THEN
00229        ICHAN=2
00230         AX   =AMRA
00231         GX   =GAMRA
00232         AMRA =AMRB
00233         GAMRA=GAMRB
00234         AMRB =AX
00235         GAMRB=GX
00236         PX   =PROB1
00237         PROB1=PROB2
00238         PROB2=PX
00239       ELSE
00240        ICHAN=3
00241       ENDIF
00242 C
00243       PROB3=1.0-PROB1-PROB2
00244       END
00245       SUBROUTINE INITDK
00246 * ----------------------------------------------------------------------
00247 *     INITIALISATION OF TAU DECAY PARAMETERS  and routines
00248 *
00249 *     called by : KORALZ
00250 * ----------------------------------------------------------------------
00251 
00252       COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00253       REAL*4            GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00254       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00255      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00256      *                 ,AMK,AMKZ,AMKST,GAMKST
00257 *
00258       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00259      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00260      *                 ,AMK,AMKZ,AMKST,GAMKST
00261       COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00262       COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00263       REAL*4            BRA1,BRK0,BRK0B,BRKS
00264 
00265 
00266 
00267 
00268 
00269 
00270       PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3)
00271       COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE)
00272      &                ,NAMES
00273       CHARACTER NAMES(NMODE)*31
00274 
00275       CHARACTER OLDNAMES(7)*31
00276       CHARACTER*80 bxINIT
00277       PARAMETER (
00278      $  bxINIT ='(1x,1h*,g17.8,            16x, a31,a4,a4, 1x,1h*)'
00279      $ )
00280       REAL*4 PI,POL1(4)
00281 *
00282 *
00283 * LIST OF BRANCHING RATIOS
00284 CAM normalised to e nu nutau channel
00285 CAM                  enu   munu   pinu  rhonu   A1nu   Knu    K*nu   pi
00286 CAM   DATA JLIST  /    1,     2,     3,     4,     5,     6,     7,
00287 *AM   DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616
00288 *AM
00289 *AM  multipion decays
00290 *
00291 *    conventions of particles names
00292 *                 K-,P-,K+,  K0,P-,KB,  K-,P0,K0
00293 *                  3, 1,-3  , 4, 1,-4  , 3, 2, 4  ,
00294 *                 P0,P0,K-,  K-,P-,P+,  P-,KB,P0
00295 *                  2, 2, 3  , 3, 1,-1  , 1,-4, 2  ,
00296 *                 ET,P-,P0   P-,P0,GM
00297 *                  9, 1, 2  , 1, 2, 8
00298 *
00299 C
00300       DIMENSION NOPIK(6,NMODE),NPIK(NMODE)
00301 *AM   outgoing multiplicity and flavors of multi-pion /multi-K modes    
00302       DATA   NPIK  /                4,                    4,  
00303      1                              5,                    5,
00304      2                              6,                    6,
00305      3                              3,                    3,            
00306      4                              3,                    3,            
00307      5                              3,                    3,            
00308      6                              3,                    3,  
00309      7                              2                         /         
00310       DATA  NOPIK / -1,-1, 1, 2, 0, 0,     2, 2, 2,-1, 0, 0,  
00311      1              -1,-1, 1, 2, 2, 0,    -1,-1,-1, 1, 1, 0,  
00312      2              -1,-1,-1, 1, 1, 2,    -1,-1, 1, 2, 2, 2, 
00313      3              -3,-1, 3, 0, 0, 0,    -4,-1, 4, 0, 0, 0,  
00314      4              -3, 2,-4, 0, 0, 0,     2, 2,-3, 0, 0, 0,  
00315      5              -3,-1, 1, 0, 0, 0,    -1, 4, 2, 0, 0, 0,  
00316      6               9,-1, 2, 0, 0, 0,    -1, 2, 8, 0, 0, 0,
00317 C AJWMOD fix sign bug, 2/22/99
00318      7              -3,-4, 0, 0, 0, 0                         /
00319 * LIST OF BRANCHING RATIOS
00320       NCHAN = NMODE + 7
00321       DO 1 I = 1,30
00322       IF (I.LE.NCHAN) THEN
00323         JLIST(I) = I
00324         IF(I.EQ. 1) GAMPRT(I) =0.1800 
00325         IF(I.EQ. 2) GAMPRT(I) =0.1751 
00326         IF(I.EQ. 3) GAMPRT(I) =0.1110 
00327         IF(I.EQ. 4) GAMPRT(I) =0.2515 
00328         IF(I.EQ. 5) GAMPRT(I) =0.1790 
00329         IF(I.EQ. 6) GAMPRT(I) =0.0071 
00330         IF(I.EQ. 7) GAMPRT(I) =0.0134
00331         IF(I.EQ. 8) GAMPRT(I) =0.0450
00332         IF(I.EQ. 9) GAMPRT(I) =0.0100
00333         IF(I.EQ.10) GAMPRT(I) =0.0009
00334         IF(I.EQ.11) GAMPRT(I) =0.0004 
00335         IF(I.EQ.12) GAMPRT(I) =0.0003 
00336         IF(I.EQ.13) GAMPRT(I) =0.0005 
00337         IF(I.EQ.14) GAMPRT(I) =0.0015 
00338         IF(I.EQ.15) GAMPRT(I) =0.0015 
00339         IF(I.EQ.16) GAMPRT(I) =0.0015 
00340         IF(I.EQ.17) GAMPRT(I) =0.0005
00341         IF(I.EQ.18) GAMPRT(I) =0.0050
00342         IF(I.EQ.19) GAMPRT(I) =0.0055
00343         IF(I.EQ.20) GAMPRT(I) =0.0017 
00344         IF(I.EQ.21) GAMPRT(I) =0.0013 
00345         IF(I.EQ.22) GAMPRT(I) =0.0010 
00346         IF(I.EQ. 1) OLDNAMES(I)='  TAU-  -->   E-               '
00347         IF(I.EQ. 2) OLDNAMES(I)='  TAU-  -->  MU-               '
00348         IF(I.EQ. 3) OLDNAMES(I)='  TAU-  -->  PI-               '
00349         IF(I.EQ. 4) OLDNAMES(I)='  TAU-  -->  PI-, PI0          '
00350         IF(I.EQ. 5) OLDNAMES(I)='  TAU-  -->  A1- (two subch)   '
00351         IF(I.EQ. 6) OLDNAMES(I)='  TAU-  -->   K-               '
00352         IF(I.EQ. 7) OLDNAMES(I)='  TAU-  -->  K*- (two subch)   '
00353         IF(I.EQ. 8) NAMES(I-7)='  TAU-  --> 2PI-,  PI0,  PI+   '
00354         IF(I.EQ. 9) NAMES(I-7)='  TAU-  --> 3PI0,        PI-   '
00355         IF(I.EQ.10) NAMES(I-7)='  TAU-  --> 2PI-,  PI+, 2PI0   '
00356         IF(I.EQ.11) NAMES(I-7)='  TAU-  --> 3PI-, 2PI+,        '
00357         IF(I.EQ.12) NAMES(I-7)='  TAU-  --> 3PI-, 2PI+,  PI0   '
00358         IF(I.EQ.13) NAMES(I-7)='  TAU-  --> 2PI-,  PI+, 3PI0   '
00359         IF(I.EQ.14) NAMES(I-7)='  TAU-  -->  K-, PI-,  K+      '
00360         IF(I.EQ.15) NAMES(I-7)='  TAU-  -->  K0, PI-, K0B      '
00361         IF(I.EQ.16) NAMES(I-7)='  TAU-  -->  K-,  K0, PI0      '
00362         IF(I.EQ.17) NAMES(I-7)='  TAU-  --> PI0  PI0   K-      '
00363         IF(I.EQ.18) NAMES(I-7)='  TAU-  -->  K-  PI-  PI+      '
00364         IF(I.EQ.19) NAMES(I-7)='  TAU-  --> PI-  K0B  PI0      '
00365         IF(I.EQ.20) NAMES(I-7)='  TAU-  --> ETA  PI-  PI0      '
00366         IF(I.EQ.21) NAMES(I-7)='  TAU-  --> PI-  PI0  GAM      '
00367         IF(I.EQ.22) NAMES(I-7)='  TAU-  -->  K-  K0            '
00368       ELSE
00369         JLIST(I) = 0
00370         GAMPRT(I) = 0.
00371       ENDIF
00372    1  CONTINUE
00373       DO I=1,NMODE
00374         MULPIK(I)=NPIK(I)
00375         DO J=1,MULPIK(I)
00376          IDFFIN(J,I)=NOPIK(J,I)
00377         ENDDO
00378       ENDDO
00379 *
00380 *
00381 * --- COEFFICIENTS TO FIX RATIO OF:
00382 * --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
00383 * --- PROBABILITY OF K0 TO BE KS
00384 * --- PROBABILITY OF K0B TO BE KS
00385 * --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
00386 * --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
00387 * --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
00388 * --- NEGLECTS MASS-PHASE SPACE EFFECTS
00389       BRA1=0.5
00390       BRK0=0.5
00391       BRK0B=0.5
00392       BRKS=0.6667
00393 *
00394 
00395       GFERMI = 1.16637E-5
00396       CCABIB = 0.975
00397       GV     = 1.0
00398       GA     =-1.0
00399 
00400 
00401 
00402 * ZW 13.04.89 HERE WAS AN ERROR
00403       SCABIB = SQRT(1.-CCABIB**2)
00404       PI =4.*ATAN(1.)
00405       GAMEL  = GFERMI**2*AMTAU**5/(192*PI**3)
00406 *
00407        CALL DEXAY(-1,POL1)
00408 *
00409       RETURN
00410       END
00411       FUNCTION DCDMAS(IDENT)
00412       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00413      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00414      *                 ,AMK,AMKZ,AMKST,GAMKST
00415 *
00416       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00417      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00418      *                 ,AMK,AMKZ,AMKST,GAMKST
00419       IF      (IDENT.EQ. 1) THEN
00420         APKMAS=AMPI
00421       ELSEIF  (IDENT.EQ.-1) THEN
00422         APKMAS=AMPI
00423       ELSEIF  (IDENT.EQ. 2) THEN
00424         APKMAS=AMPIZ
00425       ELSEIF  (IDENT.EQ.-2) THEN
00426         APKMAS=AMPIZ
00427       ELSEIF  (IDENT.EQ. 3) THEN
00428         APKMAS=AMK
00429       ELSEIF  (IDENT.EQ.-3) THEN
00430         APKMAS=AMK
00431       ELSEIF  (IDENT.EQ. 4) THEN
00432         APKMAS=AMKZ
00433       ELSEIF  (IDENT.EQ.-4) THEN
00434         APKMAS=AMKZ
00435       ELSEIF  (IDENT.EQ. 8) THEN
00436         APKMAS=0.0001
00437       ELSEIF  (IDENT.EQ.-8) THEN
00438         APKMAS=0.0001
00439       ELSEIF  (IDENT.EQ. 9) THEN
00440         APKMAS=0.5488
00441       ELSEIF  (IDENT.EQ.-9) THEN
00442         APKMAS=0.5488
00443       ELSE
00444         PRINT *, 'STOP IN APKMAS, WRONG IDENT=',IDENT
00445         STOP
00446       ENDIF
00447       DCDMAS=APKMAS
00448       END
00449       FUNCTION LUNPIK(ID,ISGN)
00450       COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00451       REAL*4            BRA1,BRK0,BRK0B,BRKS
00452       REAL*4 XIO(1)
00453       IDENT=ID*ISGN
00454       IF      (IDENT.EQ. 1) THEN
00455         IPKDEF=-211
00456       ELSEIF  (IDENT.EQ.-1) THEN
00457         IPKDEF= 211
00458       ELSEIF  (IDENT.EQ. 2) THEN
00459         IPKDEF=111
00460       ELSEIF  (IDENT.EQ.-2) THEN
00461         IPKDEF=111
00462       ELSEIF  (IDENT.EQ. 3) THEN
00463         IPKDEF=-321
00464       ELSEIF  (IDENT.EQ.-3) THEN
00465         IPKDEF= 321
00466       ELSEIF  (IDENT.EQ. 4) THEN
00467 *
00468 * K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
00469         CALL RANMAR(XIO,1)
00470         IF (XIO(1).GT.BRK0) THEN
00471           IPKDEF= 130
00472         ELSE
00473           IPKDEF= 310
00474         ENDIF
00475       ELSEIF  (IDENT.EQ.-4) THEN
00476 *
00477 * K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
00478         CALL RANMAR(XIO,1)
00479         IF (XIO(1).GT.BRK0B) THEN
00480           IPKDEF= 130
00481         ELSE
00482           IPKDEF= 310
00483         ENDIF
00484       ELSEIF  (IDENT.EQ. 8) THEN
00485         IPKDEF= 22
00486       ELSEIF  (IDENT.EQ.-8) THEN
00487         IPKDEF= 22
00488       ELSEIF  (IDENT.EQ. 9) THEN
00489         IPKDEF= 221
00490       ELSEIF  (IDENT.EQ.-9) THEN
00491         IPKDEF= 221
00492       ELSE
00493         PRINT *, 'STOP IN IPKDEF, WRONG IDENT=',IDENT
00494         STOP
00495       ENDIF
00496       LUNPIK=IPKDEF
00497       END
00498 
00499 
00500 
00501       SUBROUTINE TAURDF(KTO)
00502 C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
00503 C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
00504 C CONTENTS
00505       COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00506       REAL*4            BRA1,BRK0,BRK0B,BRKS
00507       COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00508       IF (KTO.EQ.1) THEN
00509 C     ==================
00510 C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
00511       BRA1 = PKORB(4,1)
00512       BRKS = PKORB(4,3)
00513       BRK0  = PKORB(4,5)
00514       BRK0B  = PKORB(4,6)
00515       ELSE
00516 C     ====
00517 C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
00518       BRA1 = PKORB(4,2)
00519       BRKS = PKORB(4,4)
00520       BRK0  = PKORB(4,5)
00521       BRK0B  = PKORB(4,6)
00522       ENDIF
00523 C     =====
00524       END
00525 
00526       SUBROUTINE INIPHX(XK00)
00527 * ----------------------------------------------------------------------
00528 *     INITIALISATION OF PARAMETERS
00529 *     USED IN QED and/or GSW ROUTINES
00530 * ----------------------------------------------------------------------
00531       COMMON / QEDPRM /ALFINV,ALFPI,XK0
00532       REAL*8           ALFINV,ALFPI,XK0
00533       REAL*8 PI8,XK00
00534 *
00535       PI8    = 4.D0*DATAN(1.D0)
00536       ALFINV = 137.03604D0
00537       ALFPI  = 1D0/(ALFINV*PI8)
00538       XK0=XK00
00539       END
00540 
00541       SUBROUTINE INIMAS
00542 C ----------------------------------------------------------------------
00543 C     INITIALISATION OF MASSES
00544 C
00545 C     called by : KORALZ
00546 C ----------------------------------------------------------------------
00547       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00548      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00549      *                 ,AMK,AMKZ,AMKST,GAMKST
00550 *
00551       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00552      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00553      *                 ,AMK,AMKZ,AMKST,GAMKST
00554 C
00555 C IN-COMING / OUT-GOING  FERMION MASSES
00556       AMTAU  = 1.7842
00557 C --- tau mass must be the same as in the host program, what-so-ever
00558       AMTAU  = 1.777
00559       AMNUTA = 0.010
00560       AMEL   = 0.0005111
00561       AMNUE  = 0.0
00562       AMMU   = 0.105659 
00563       AMNUMU = 0.0
00564 *
00565 * MASSES USED IN TAU DECAYS
00566       AMPIZ  = 0.134964
00567       AMPI   = 0.139568
00568       AMRO   = 0.773
00569       GAMRO  = 0.145
00570 *C    GAMRO  = 0.666
00571       AMA1   = 1.251
00572       GAMA1  = 0.599
00573       AMK    = 0.493667
00574       AMKZ   = 0.49772
00575       AMKST  = 0.8921
00576       GAMKST = 0.0513
00577 C
00578 C
00579 C IN-COMING / OUT-GOING  FERMION MASSES
00580 !!      AMNUTA = PKORB(1,2)
00581 !!      AMNUE  = PKORB(1,4)
00582 !!      AMNUMU = PKORB(1,6)
00583 C
00584 C MASSES USED IN TAU DECAYS  Cleo settings
00585 !!      AMPIZ  = PKORB(1,7)
00586 !!      AMPI   = PKORB(1,8)
00587 !!      AMRO   = PKORB(1,9)
00588 !!      GAMRO  = PKORB(2,9)
00589       AMA1   = 1.275   !! PKORB(1,10)
00590       GAMA1  = 0.615   !! PKORB(2,10)
00591 !!      AMK    = PKORB(1,11)
00592 !!      AMKZ   = PKORB(1,12)
00593 !!      AMKST  = PKORB(1,13)
00594 !!      GAMKST = PKORB(2,13)
00595 C
00596 
00597       RETURN
00598       END
00599       subroutine bostdq(idir,vv,pp,q)
00600 *     *******************************
00601 c Boost along arbitrary vector v (see eg. J.D. Jacson, Classical 
00602 c Electrodynamics).
00603 c Four-vector pp is boosted from an actual frame to the rest frame 
00604 c of the four-vector v (for idir=1) or back (for idir=-1). 
00605 c q is a resulting four-vector.
00606 c Note: v must be time-like, pp may be arbitrary.
00607 c
00608 c Written by: Wieslaw Placzek            date: 22.07.1994
00609 c Last update: 3/29/95                     by: M.S.
00610 c 
00611       implicit DOUBLE PRECISION (a-h,o-z)
00612       parameter (nout=6)
00613       DOUBLE PRECISION v(4),p(4),q(4),pp(4),vv(4)  
00614       save
00615 !
00616       do 1 i=1,4
00617       v(i)=vv(i)
00618  1    p(i)=pp(i)
00619       amv=(v(4)**2-v(1)**2-v(2)**2-v(3)**2)
00620       if (amv.le.0d0) then
00621         write(6,*) 'bosstv: warning amv**2=',amv
00622       endif
00623       amv=sqrt(abs(amv))
00624       if (idir.eq.-1) then
00625         q(4)=( p(1)*v(1)+p(2)*v(2)+p(3)*v(3)+p(4)*v(4))/amv
00626         wsp =(q(4)+p(4))/(v(4)+amv)
00627       elseif (idir.eq.1) then
00628         q(4)=(-p(1)*v(1)-p(2)*v(2)-p(3)*v(3)+p(4)*v(4))/amv
00629         wsp =-(q(4)+p(4))/(v(4)+amv)
00630       else
00631         write(nout,*)' >>> boostv: wrong value of idir = ',idir
00632       endif
00633       q(1)=p(1)+wsp*v(1)
00634       q(2)=p(2)+wsp*v(2)
00635       q(3)=p(3)+wsp*v(3)
00636       end
00637         
00638 
00639 
00640 
00641 
00642 
00643 
00644 
00645