tauola-F/jetset-F/tauola_photos_ini.F

00001 C this file is created by hand from taumain.F
00002 C actions: Remove routines: TAUDEM DECTES TAUFIL FILHEP
00003 C add:     INIETC will not necesarily work fine ... 
00004 C replace  TRALO4 
00005 C rename INIPHY to INIPHX
00006 
00007       SUBROUTINE INIETC(jakk1,jakk2,itd,ifpho)
00008       COMMON / IDFC  / IDFF
00009       COMMON / TAURAD / XK0DEC,ITDKRC
00010       DOUBLE PRECISION            XK0DEC
00011       COMMON / JAKI   /  JAK1,JAK2,JAKP,JAKM,KTOM
00012       COMMON /PHOACT/ IFPHOT
00013       SAVE
00014 C KTO=1 will denote tau+, thus :: IDFF=-15
00015           IDFF=-15
00016 C XK0 for tau decays.
00017           XK0DEC=0.01
00018 C radiative correction switch in tau --> e (mu) decays !
00019           ITDKRC=itd
00020 C switches of tau+ tau- decay modes !!
00021           JAK1=jakk1
00022           JAK2=jakk2
00023 C photos activation switch
00024           IFPHOT=IFPHO
00025       end
00026 
00027       SUBROUTINE TRALO4(KTOS,PHOI,PHOF,AM)
00028 !! Corrected 11.10.96 (ZW) tralor for KORALW.
00029 !! better treatment is to  cascade from tau rest-frame through W
00030 !! restframe down to LAB. 
00031       COMMON / MOMDEC / Q1,Q2,P1,P2,P3,P4
00032       COMMON /TRALID/ idtra
00033       double precision Q1(4),Q2(4),P1(4),P2(4),P3(4),P4(4),P1QQ(4),P2QQ(4)
00034       double precision PIN(4),POUT(4),PBST(4),PBS1(4),QQ(4),PI
00035       double precision THET,PHI,EXE
00036       REAL*4 PHOI(4),PHOF(4)
00037       SAVE
00038       DATA PI /3.141592653589793238462643D0/
00039       AM=SQRT(ABS
00040      $   (PHOI(4)**2-PHOI(3)**2-PHOI(2)**2-PHOI(1)**2))
00041       idtra=KTOS
00042       DO K=1,4
00043        PIN(K)=PHOI(K)
00044        PHOF(K)=PHOI(K)
00045       ENDDO
00046 !      write(*,*) idtra
00047       IF    (idtra.EQ.1) THEN
00048         DO K=1,4
00049          PBST(K)=P1(K)
00050          QQ(K)=Q1(K)
00051         ENDDO
00052       ELSEIF(idtra.EQ.2) THEN
00053         DO K=1,4
00054          PBST(K)=P2(K)
00055          QQ(K)=Q1(K)
00056         ENDDO
00057       ELSEIF(idtra.EQ.3) THEN
00058         DO K=1,4
00059          PBST(K)=P3(K)
00060          QQ(K)=Q2(K)
00061         ENDDO
00062       ELSE
00063         DO K=1,4
00064          PBST(K)=P4(K)
00065          QQ(K)=Q2(K)
00066         ENDDO
00067       ENDIF
00068 
00069 
00070 
00071         CALL BOSTDQ(1,QQ,PBST,PBST)
00072         CALL BOSTDQ(1,QQ,P1,P1QQ)
00073         CALL BOSTDQ(1,QQ,P2,P2QQ)
00074         PBS1(4)=PBST(4)
00075         PBS1(3)=SQRT(PBST(3)**2+PBST(2)**2+PBST(1)**2)
00076         PBS1(2)=0D0
00077         PBS1(1)=0D0 
00078         EXE=(PBS1(4)+PBS1(3))/DSQRT(PBS1(4)**2-PBS1(3)**2)
00079 C for KTOS=1 boost is antiparallel to 4-momentum of P2. 
00080 C restframes of tau+ tau- and 'first' frame of 'higgs' are all connected
00081 C by boosts along z axis
00082        IF(KTOS.EQ.1)  EXE=(PBS1(4)-PBS1(3))/DSQRT(PBS1(4)**2-PBS1(3)**2)
00083         CALL BOSTD3(EXE,PIN,POUT)
00084 
00085 C once in Z/gamma/Higgs rest frame we control further kinematics by P2QQ for KTOS=1,2
00086         THET=ACOS(P2QQ(3)/SQRT(P2QQ(3)**2+P2QQ(2)**2+P2QQ(1)**2))
00087         PHI=0D0
00088         PHI=ACOS(P2QQ(1)/SQRT(P2QQ(2)**2+P2QQ(1)**2))
00089         IF(P2QQ(2).LT.0D0) PHI=2*PI-PHI
00090 
00091         CALL ROTPOX(THET,PHI,POUT)
00092         CALL BOSTDQ(-1,QQ,POUT,POUT)
00093       DO K=1,4
00094        PHOF(K)=POUT(K)
00095       ENDDO
00096       END
00097 
00098 
00099       SUBROUTINE CHOICE(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
00100      $            AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
00101       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00102      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00103      *                 ,AMK,AMKZ,AMKST,GAMKST
00104 C
00105       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00106      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00107      *                 ,AMK,AMKZ,AMKST,GAMKST
00108 C
00109       AMROP=1.1
00110       GAMROP=0.36
00111       AMOM=.782
00112       GAMOM=0.0084
00113 C     XXXXA CORRESPOND TO S2 CHANNEL !
00114       IF(MNUM.EQ.0) THEN
00115        PROB1=0.5
00116        PROB2=0.5
00117        AMRX =AMA1
00118        GAMRX=GAMA1
00119        AMRA =AMRO
00120        GAMRA=GAMRO
00121        AMRB =AMRO
00122        GAMRB=GAMRO
00123       ELSEIF(MNUM.EQ.1) THEN
00124        PROB1=0.5
00125        PROB2=0.5
00126        AMRX =1.57
00127        GAMRX=0.9
00128        AMRB =AMKST
00129        GAMRB=GAMKST
00130        AMRA =AMRO
00131        GAMRA=GAMRO
00132       ELSEIF(MNUM.EQ.2) THEN
00133        PROB1=0.5
00134        PROB2=0.5
00135        AMRX =1.57
00136        GAMRX=0.9
00137        AMRB =AMKST
00138        GAMRB=GAMKST
00139        AMRA =AMRO
00140        GAMRA=GAMRO
00141       ELSEIF(MNUM.EQ.3) THEN
00142        PROB1=0.5
00143        PROB2=0.5
00144        AMRX =1.27
00145        GAMRX=0.3
00146        AMRA =AMKST
00147        GAMRA=GAMKST
00148        AMRB =AMKST
00149        GAMRB=GAMKST
00150       ELSEIF(MNUM.EQ.4) THEN
00151        PROB1=0.5
00152        PROB2=0.5
00153        AMRX =1.27
00154        GAMRX=0.3
00155        AMRA =AMKST
00156        GAMRA=GAMKST
00157        AMRB =AMKST
00158        GAMRB=GAMKST
00159       ELSEIF(MNUM.EQ.5) THEN
00160        PROB1=0.5
00161        PROB2=0.5
00162        AMRX =1.27
00163        GAMRX=0.3
00164        AMRA =AMKST
00165        GAMRA=GAMKST
00166        AMRB =AMRO
00167        GAMRB=GAMRO
00168       ELSEIF(MNUM.EQ.6) THEN
00169        PROB1=0.4
00170        PROB2=0.4
00171        AMRX =1.27
00172        GAMRX=0.3
00173        AMRA =AMRO
00174        GAMRA=GAMRO
00175        AMRB =AMKST
00176        GAMRB=GAMKST
00177       ELSEIF(MNUM.EQ.7) THEN
00178        PROB1=0.0
00179        PROB2=1.0
00180        AMRX =1.27
00181        GAMRX=0.9
00182        AMRA =AMRO
00183        GAMRA=GAMRO
00184        AMRB =AMRO
00185        GAMRB=GAMRO
00186       ELSEIF(MNUM.EQ.8) THEN
00187        PROB1=0.0
00188        PROB2=1.0
00189        AMRX =AMROP
00190        GAMRX=GAMROP
00191        AMRB =AMOM
00192        GAMRB=GAMOM
00193        AMRA =AMRO
00194        GAMRA=GAMRO
00195       ELSEIF(MNUM.EQ.101) THEN
00196        PROB1=.35
00197        PROB2=.35
00198        AMRX =1.2
00199        GAMRX=.46
00200        AMRB =AMOM
00201        GAMRB=GAMOM
00202        AMRA =AMOM
00203        GAMRA=GAMOM
00204       ELSEIF(MNUM.EQ.102) THEN
00205        PROB1=0.0
00206        PROB2=0.0
00207        AMRX =1.4
00208        GAMRX=.6
00209        AMRB =AMOM
00210        GAMRB=GAMOM
00211        AMRA =AMOM
00212        GAMRA=GAMOM
00213       ELSE
00214        PROB1=0.0
00215        PROB2=0.0
00216        AMRX =AMA1
00217        GAMRX=GAMA1
00218        AMRA =AMRO
00219        GAMRA=GAMRO
00220        AMRB =AMRO
00221        GAMRB=GAMRO
00222       ENDIF
00223 C
00224       IF    (RR.LE.PROB1) THEN
00225        ICHAN=1
00226       ELSEIF(RR.LE.(PROB1+PROB2)) THEN
00227        ICHAN=2
00228         AX   =AMRA
00229         GX   =GAMRA
00230         AMRA =AMRB
00231         GAMRA=GAMRB
00232         AMRB =AX
00233         GAMRB=GX
00234         PX   =PROB1
00235         PROB1=PROB2
00236         PROB2=PX
00237       ELSE
00238        ICHAN=3
00239       ENDIF
00240 C
00241       PROB3=1.0-PROB1-PROB2
00242       END
00243       SUBROUTINE INITDK
00244 * ----------------------------------------------------------------------
00245 *     INITIALISATION OF TAU DECAY PARAMETERS  and routines
00246 *
00247 *     called by : KORALZ
00248 * ----------------------------------------------------------------------
00249 
00250       COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00251       REAL*4            GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00252       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00253      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00254      *                 ,AMK,AMKZ,AMKST,GAMKST
00255 *
00256       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00257      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00258      *                 ,AMK,AMKZ,AMKST,GAMKST
00259       COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00260       COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00261       REAL*4            BRA1,BRK0,BRK0B,BRKS
00262 #if defined (ALEPH)
00263       PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3)
00264       COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE)
00265      &                ,NAMES
00266       CHARACTER NAMES(NMODE)*31
00267 #else
00268       PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3)
00269       COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE)
00270      &                ,NAMES
00271       CHARACTER NAMES(NMODE)*31
00272 #endif
00273       CHARACTER OLDNAMES(7)*31
00274       CHARACTER*80 bxINIT
00275       PARAMETER (
00276      $  bxINIT ='(1x,1h*,g17.8,            16x, a31,a4,a4, 1x,1h*)'
00277      $ )
00278       REAL*4 PI,POL1(4)
00279 *
00280 *
00281 * LIST OF BRANCHING RATIOS
00282 CAM normalised to e nu nutau channel
00283 CAM                  enu   munu   pinu  rhonu   A1nu   Knu    K*nu   pi
00284 CAM   DATA JLIST  /    1,     2,     3,     4,     5,     6,     7,
00285 #if defined (ALEPH)
00286 CAM               /0.1779,0.1731,0.1106,0.2530,0.1811,0.0072,0.0139
00287 CAM   DATA GAMPRT / 1.000,0.9732,0.6217,1.4221,1.0180,0.0405,0.0781
00288 CAM   DATA GAMPRT /1.000,0.9676,0.6154,1.3503,1.0225,0.0368,O.O758
00289 CAM
00290 C
00291 C    conventions of particles names
00292 c
00293 cam  mode (JAK)                     8                     9
00294 CAM  channel          pi- pi- pi0 pi+              3pi0 pi-
00295 cam  particle code  -1,-1, 2, 1, 0, 0,     2, 2, 2,-1, 0, 0,
00296 CAM  BR relative to electron    .2414,                .0601,
00297 c
00298 *                                  10                    11
00299 *    1                     3pi+- 2pi0                 5pi+-
00300 *    1              -1,-1, 1, 2, 2, 0,    -1,-1,-1, 1, 1, 0,
00301 *    1                          .0281,                .0045,
00302 
00303 *                                  12                    13
00304 *    2                      5pi+- pi0            3pi+- 3pi0
00305 *    2              -1,-1,-1, 1, 1, 2,    -1,-1, 1, 2, 2, 2,
00306 *    2                          .0010,                .0062,
00307 
00308 *                                  14                    15
00309 *    3                      K- pi- K+             K0 pi- KB
00310 *    3              -3,-1, 3, 0, 0, 0,     4,-1,-4, 0, 0, 0,
00311 *    3                          .0096,                .0169,
00312 
00313 *                                  16                    17
00314 *    4                      K- pi0 K0               2pi0 K-
00315 *    4              -3, 2, 4, 0, 0, 0,     2, 2,-3, 0, 0, 0,
00316 *    4                          .0056,                .0045,
00317 
00318 *                                  18                    19
00319 *    5                     K- pi- pi+            pi- KB pi0
00320 *    5              -3,-1, 1, 0, 0, 0,    -1,-4, 2, 0, 0, 0,
00321 *    5                          .0219,                .0180,
00322 
00323 *                                  20                    21
00324 *    6                    eta pi- pi0         pi- pi0 gamma
00325 *    6               9,-1, 2, 0, 0, 0,    -1, 2, 8, 0, 0, 0,
00326 *    6                          .0096,                .0088,
00327 
00328 *                                  22   /
00329 *    7                          K- K0   /
00330 *    7                          -3, 4   /
00331 *    7                          .0146   /
00332 #else
00333 *AM   DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616
00334 *AM
00335 *AM  multipion decays
00336 *
00337 *    conventions of particles names
00338 *                 K-,P-,K+,  K0,P-,KB,  K-,P0,K0
00339 *                  3, 1,-3  , 4, 1,-4  , 3, 2, 4  ,
00340 *                 P0,P0,K-,  K-,P-,P+,  P-,KB,P0
00341 *                  2, 2, 3  , 3, 1,-1  , 1,-4, 2  ,
00342 *                 ET,P-,P0   P-,P0,GM
00343 *                  9, 1, 2  , 1, 2, 8
00344 *
00345 #endif
00346 C
00347       DIMENSION NOPIK(6,NMODE),NPIK(NMODE)
00348 *AM   outgoing multiplicity and flavors of multi-pion /multi-K modes    
00349       DATA   NPIK  /                4,                    4,  
00350      1                              5,                    5,
00351      2                              6,                    6,
00352      3                              3,                    3,            
00353      4                              3,                    3,            
00354      5                              3,                    3,            
00355      6                              3,                    3,  
00356      7                              2                         /         
00357 #if defined (ALEPH)
00358       DATA  NOPIK / -1,-1, 2, 1, 0, 0,     2, 2, 2,-1, 0, 0,
00359      1              -1,-1, 1, 2, 2, 0,    -1,-1,-1, 1, 1, 0,
00360      2              -1,-1,-1, 1, 1, 2,    -1,-1, 1, 2, 2, 2,
00361      3              -3,-1, 3, 0, 0, 0,     4,-1,-4, 0, 0, 0,
00362      4              -3, 2, 4, 0, 0, 0,     2, 2,-3, 0, 0, 0,
00363      5              -3,-1, 1, 0, 0, 0,    -1,-4, 2, 0, 0, 0,
00364      6               9,-1, 2, 0, 0, 0,    -1, 2, 8, 0, 0, 0,
00365 #else
00366       DATA  NOPIK / -1,-1, 1, 2, 0, 0,     2, 2, 2,-1, 0, 0,  
00367      1              -1,-1, 1, 2, 2, 0,    -1,-1,-1, 1, 1, 0,  
00368      2              -1,-1,-1, 1, 1, 2,    -1,-1, 1, 2, 2, 2, 
00369      3              -3,-1, 3, 0, 0, 0,    -4,-1, 4, 0, 0, 0,  
00370      4              -3, 2,-4, 0, 0, 0,     2, 2,-3, 0, 0, 0,  
00371      5              -3,-1, 1, 0, 0, 0,    -1, 4, 2, 0, 0, 0,  
00372      6               9,-1, 2, 0, 0, 0,    -1, 2, 8, 0, 0, 0,
00373 #endif
00374 #if defined (CLEO)
00375 C AJWMOD fix sign bug, 2/22/99
00376      7              -3,-4, 0, 0, 0, 0                         /
00377 #else
00378      7              -3, 4, 0, 0, 0, 0                         /
00379 #endif
00380 * LIST OF BRANCHING RATIOS
00381       NCHAN = NMODE + 7
00382       DO 1 I = 1,30
00383       IF (I.LE.NCHAN) THEN
00384         JLIST(I) = I
00385 #if defined (CePeCe)
00386         IF(I.EQ. 1) GAMPRT(I) = 1.0000
00387         IF(I.EQ. 2) GAMPRT(I) = 1.0000
00388         IF(I.EQ. 3) GAMPRT(I) = 1.0000
00389         IF(I.EQ. 4) GAMPRT(I) = 1.0000
00390         IF(I.EQ. 5) GAMPRT(I) = 1.0000
00391         IF(I.EQ. 6) GAMPRT(I) = 1.0000
00392         IF(I.EQ. 7) GAMPRT(I) = 1.0000
00393         IF(I.EQ. 8) GAMPRT(I) = 1.0000
00394         IF(I.EQ. 9) GAMPRT(I) = 1.0000
00395         IF(I.EQ.10) GAMPRT(I) = 1.0000
00396         IF(I.EQ.11) GAMPRT(I) = 1.0000
00397         IF(I.EQ.12) GAMPRT(I) = 1.0000
00398         IF(I.EQ.13) GAMPRT(I) = 1.0000
00399         IF(I.EQ.14) GAMPRT(I) = 1.0000
00400         IF(I.EQ.15) GAMPRT(I) = 1.0000
00401         IF(I.EQ.16) GAMPRT(I) = 1.0000
00402         IF(I.EQ.17) GAMPRT(I) = 1.0000
00403         IF(I.EQ.18) GAMPRT(I) = 1.0000
00404         IF(I.EQ.19) GAMPRT(I) = 1.0000
00405         IF(I.EQ.20) GAMPRT(I) = 1.0000
00406         IF(I.EQ.21) GAMPRT(I) = 1.0000
00407         IF(I.EQ.22) GAMPRT(I) = 1.0000
00408 #elif defined (CLEO)
00409         IF(I.EQ. 1) GAMPRT(I) =0.1800 
00410         IF(I.EQ. 2) GAMPRT(I) =0.1751 
00411         IF(I.EQ. 3) GAMPRT(I) =0.1110 
00412         IF(I.EQ. 4) GAMPRT(I) =0.2515 
00413         IF(I.EQ. 5) GAMPRT(I) =0.1790 
00414         IF(I.EQ. 6) GAMPRT(I) =0.0071 
00415         IF(I.EQ. 7) GAMPRT(I) =0.0134
00416         IF(I.EQ. 8) GAMPRT(I) =0.0450
00417         IF(I.EQ. 9) GAMPRT(I) =0.0100
00418         IF(I.EQ.10) GAMPRT(I) =0.0009
00419         IF(I.EQ.11) GAMPRT(I) =0.0004 
00420         IF(I.EQ.12) GAMPRT(I) =0.0003 
00421         IF(I.EQ.13) GAMPRT(I) =0.0005 
00422         IF(I.EQ.14) GAMPRT(I) =0.0015 
00423         IF(I.EQ.15) GAMPRT(I) =0.0015 
00424         IF(I.EQ.16) GAMPRT(I) =0.0015 
00425         IF(I.EQ.17) GAMPRT(I) =0.0005
00426         IF(I.EQ.18) GAMPRT(I) =0.0050
00427         IF(I.EQ.19) GAMPRT(I) =0.0055
00428         IF(I.EQ.20) GAMPRT(I) =0.0017 
00429         IF(I.EQ.21) GAMPRT(I) =0.0013 
00430         IF(I.EQ.22) GAMPRT(I) =0.0010 
00431 #elif defined (ALEPH)
00432         IF(I.EQ. 1) GAMPRT(I) = 1.0000
00433         IF(I.EQ. 2) GAMPRT(I) =  .9732
00434         IF(I.EQ. 3) GAMPRT(I) =  .6217
00435         IF(I.EQ. 4) GAMPRT(I) = 1.4221
00436         IF(I.EQ. 5) GAMPRT(I) = 1.0180
00437         IF(I.EQ. 6) GAMPRT(I) =  .0405
00438         IF(I.EQ. 7) GAMPRT(I) =  .0781
00439         IF(I.EQ. 8) GAMPRT(I) =  .2414
00440         IF(I.EQ. 9) GAMPRT(I) =  .0601
00441         IF(I.EQ.10) GAMPRT(I) =  .0281
00442         IF(I.EQ.11) GAMPRT(I) =  .0045
00443         IF(I.EQ.12) GAMPRT(I) =  .0010
00444         IF(I.EQ.13) GAMPRT(I) =  .0062
00445         IF(I.EQ.14) GAMPRT(I) =  .0096
00446         IF(I.EQ.15) GAMPRT(I) =  .0169
00447         IF(I.EQ.16) GAMPRT(I) =  .0056
00448         IF(I.EQ.17) GAMPRT(I) =  .0045
00449         IF(I.EQ.18) GAMPRT(I) =  .0219
00450         IF(I.EQ.19) GAMPRT(I) =  .0180
00451         IF(I.EQ.20) GAMPRT(I) =  .0096
00452         IF(I.EQ.21) GAMPRT(I) =  .0088
00453         IF(I.EQ.22) GAMPRT(I) =  .0146
00454 #else
00455 #endif
00456         IF(I.EQ. 1) OLDNAMES(I)='  TAU-  -->   E-               '
00457         IF(I.EQ. 2) OLDNAMES(I)='  TAU-  -->  MU-               '
00458         IF(I.EQ. 3) OLDNAMES(I)='  TAU-  -->  PI-               '
00459         IF(I.EQ. 4) OLDNAMES(I)='  TAU-  -->  PI-, PI0          '
00460         IF(I.EQ. 5) OLDNAMES(I)='  TAU-  -->  A1- (two subch)   '
00461         IF(I.EQ. 6) OLDNAMES(I)='  TAU-  -->   K-               '
00462         IF(I.EQ. 7) OLDNAMES(I)='  TAU-  -->  K*- (two subch)   '
00463         IF(I.EQ. 8) NAMES(I-7)='  TAU-  --> 2PI-,  PI0,  PI+   '
00464         IF(I.EQ. 9) NAMES(I-7)='  TAU-  --> 3PI0,        PI-   '
00465         IF(I.EQ.10) NAMES(I-7)='  TAU-  --> 2PI-,  PI+, 2PI0   '
00466         IF(I.EQ.11) NAMES(I-7)='  TAU-  --> 3PI-, 2PI+,        '
00467         IF(I.EQ.12) NAMES(I-7)='  TAU-  --> 3PI-, 2PI+,  PI0   '
00468         IF(I.EQ.13) NAMES(I-7)='  TAU-  --> 2PI-,  PI+, 3PI0   '
00469         IF(I.EQ.14) NAMES(I-7)='  TAU-  -->  K-, PI-,  K+      '
00470         IF(I.EQ.15) NAMES(I-7)='  TAU-  -->  K0, PI-, K0B      '
00471 #if defined (ALEPH)
00472         IF(I.EQ.16) NAMES(I-7)='  TAU-  -->  K-  PI0   K0      '
00473 #else
00474         IF(I.EQ.16) NAMES(I-7)='  TAU-  -->  K-,  K0, PI0      '
00475 #endif
00476         IF(I.EQ.17) NAMES(I-7)='  TAU-  --> PI0  PI0   K-      '
00477         IF(I.EQ.18) NAMES(I-7)='  TAU-  -->  K-  PI-  PI+      '
00478         IF(I.EQ.19) NAMES(I-7)='  TAU-  --> PI-  K0B  PI0      '
00479         IF(I.EQ.20) NAMES(I-7)='  TAU-  --> ETA  PI-  PI0      '
00480         IF(I.EQ.21) NAMES(I-7)='  TAU-  --> PI-  PI0  GAM      '
00481         IF(I.EQ.22) NAMES(I-7)='  TAU-  -->  K-  K0            '
00482       ELSE
00483         JLIST(I) = 0
00484         GAMPRT(I) = 0.
00485       ENDIF
00486    1  CONTINUE
00487       DO I=1,NMODE
00488         MULPIK(I)=NPIK(I)
00489         DO J=1,MULPIK(I)
00490          IDFFIN(J,I)=NOPIK(J,I)
00491         ENDDO
00492       ENDDO
00493 *
00494 *
00495 * --- COEFFICIENTS TO FIX RATIO OF:
00496 * --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
00497 * --- PROBABILITY OF K0 TO BE KS
00498 * --- PROBABILITY OF K0B TO BE KS
00499 * --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
00500 * --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
00501 * --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
00502 * --- NEGLECTS MASS-PHASE SPACE EFFECTS
00503       BRA1=0.5
00504       BRK0=0.5
00505       BRK0B=0.5
00506       BRKS=0.6667
00507 *
00508 
00509       GFERMI = 1.16637E-5
00510       CCABIB = 0.975
00511       GV     = 1.0
00512       GA     =-1.0
00513 
00514 
00515 
00516 * ZW 13.04.89 HERE WAS AN ERROR
00517       SCABIB = SQRT(1.-CCABIB**2)
00518       PI =4.*ATAN(1.)
00519       GAMEL  = GFERMI**2*AMTAU**5/(192*PI**3)
00520 *
00521        CALL DEXAY(-1,POL1)
00522 *
00523       RETURN
00524       END
00525       FUNCTION DCDMAS(IDENT)
00526       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00527      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00528      *                 ,AMK,AMKZ,AMKST,GAMKST
00529 *
00530       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00531      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00532      *                 ,AMK,AMKZ,AMKST,GAMKST
00533       IF      (IDENT.EQ. 1) THEN
00534         APKMAS=AMPI
00535       ELSEIF  (IDENT.EQ.-1) THEN
00536         APKMAS=AMPI
00537       ELSEIF  (IDENT.EQ. 2) THEN
00538         APKMAS=AMPIZ
00539       ELSEIF  (IDENT.EQ.-2) THEN
00540         APKMAS=AMPIZ
00541       ELSEIF  (IDENT.EQ. 3) THEN
00542         APKMAS=AMK
00543       ELSEIF  (IDENT.EQ.-3) THEN
00544         APKMAS=AMK
00545       ELSEIF  (IDENT.EQ. 4) THEN
00546         APKMAS=AMKZ
00547       ELSEIF  (IDENT.EQ.-4) THEN
00548         APKMAS=AMKZ
00549       ELSEIF  (IDENT.EQ. 8) THEN
00550         APKMAS=0.0001
00551       ELSEIF  (IDENT.EQ.-8) THEN
00552         APKMAS=0.0001
00553       ELSEIF  (IDENT.EQ. 9) THEN
00554         APKMAS=0.5488
00555       ELSEIF  (IDENT.EQ.-9) THEN
00556         APKMAS=0.5488
00557       ELSE
00558         PRINT *, 'STOP IN APKMAS, WRONG IDENT=',IDENT
00559         STOP
00560       ENDIF
00561       DCDMAS=APKMAS
00562       END
00563       FUNCTION LUNPIK(ID,ISGN)
00564       COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00565       REAL*4            BRA1,BRK0,BRK0B,BRKS
00566       REAL*4 XIO(1)
00567       IDENT=ID*ISGN
00568 #if defined (ALEPH)
00569       IF      (IDENT.EQ. 1) THEN
00570         IPKDEF= 211
00571       ELSEIF  (IDENT.EQ.-1) THEN
00572         IPKDEF=-211
00573       ELSEIF  (IDENT.EQ. 2) THEN
00574         IPKDEF= 111
00575       ELSEIF  (IDENT.EQ.-2) THEN
00576         IPKDEF= 111
00577       ELSEIF  (IDENT.EQ. 3) THEN
00578         IPKDEF= 321
00579       ELSEIF  (IDENT.EQ.-3) THEN
00580         IPKDEF=-321
00581 #else
00582       IF      (IDENT.EQ. 1) THEN
00583         IPKDEF=-211
00584       ELSEIF  (IDENT.EQ.-1) THEN
00585         IPKDEF= 211
00586       ELSEIF  (IDENT.EQ. 2) THEN
00587         IPKDEF=111
00588       ELSEIF  (IDENT.EQ.-2) THEN
00589         IPKDEF=111
00590       ELSEIF  (IDENT.EQ. 3) THEN
00591         IPKDEF=-321
00592       ELSEIF  (IDENT.EQ.-3) THEN
00593         IPKDEF= 321
00594 #endif
00595       ELSEIF  (IDENT.EQ. 4) THEN
00596 *
00597 * K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
00598         CALL RANMAR(XIO,1)
00599         IF (XIO(1).GT.BRK0) THEN
00600           IPKDEF= 130
00601         ELSE
00602           IPKDEF= 310
00603         ENDIF
00604       ELSEIF  (IDENT.EQ.-4) THEN
00605 *
00606 * K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
00607         CALL RANMAR(XIO,1)
00608         IF (XIO(1).GT.BRK0B) THEN
00609           IPKDEF= 130
00610         ELSE
00611           IPKDEF= 310
00612         ENDIF
00613       ELSEIF  (IDENT.EQ. 8) THEN
00614         IPKDEF= 22
00615       ELSEIF  (IDENT.EQ.-8) THEN
00616         IPKDEF= 22
00617       ELSEIF  (IDENT.EQ. 9) THEN
00618         IPKDEF= 221
00619       ELSEIF  (IDENT.EQ.-9) THEN
00620         IPKDEF= 221
00621       ELSE
00622         PRINT *, 'STOP IN IPKDEF, WRONG IDENT=',IDENT
00623         STOP
00624       ENDIF
00625       LUNPIK=IPKDEF
00626       END
00627 
00628 
00629 #if defined (CLEO)
00630 
00631       SUBROUTINE TAURDF(KTO)
00632 C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
00633 C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
00634 C CONTENTS
00635       COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00636       REAL*4            BRA1,BRK0,BRK0B,BRKS
00637       COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00638       IF (KTO.EQ.1) THEN
00639 C     ==================
00640 C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
00641       BRA1 = PKORB(4,1)
00642       BRKS = PKORB(4,3)
00643       BRK0  = PKORB(4,5)
00644       BRK0B  = PKORB(4,6)
00645       ELSE
00646 C     ====
00647 C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
00648       BRA1 = PKORB(4,2)
00649       BRKS = PKORB(4,4)
00650       BRK0  = PKORB(4,5)
00651       BRK0B  = PKORB(4,6)
00652       ENDIF
00653 C     =====
00654       END
00655 #else
00656 
00657       SUBROUTINE TAURDF(KTO)
00658 * THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
00659 * IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
00660 * CONTENTS
00661       COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00662       REAL*4            BRA1,BRK0,BRK0B,BRKS
00663       COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00664       IF (KTO.EQ.1) THEN
00665 *     ==================
00666 * LIST OF BRANCHING RATIOS
00667       NCHAN = 19
00668       DO 1 I = 1,30
00669       IF (I.LE.NCHAN) THEN
00670         JLIST(I) = I
00671         IF(I.EQ. 1) GAMPRT(I) = .0000
00672         IF(I.EQ. 2) GAMPRT(I) = .0000
00673         IF(I.EQ. 3) GAMPRT(I) = .0000
00674         IF(I.EQ. 4) GAMPRT(I) = .0000
00675         IF(I.EQ. 5) GAMPRT(I) = .0000
00676         IF(I.EQ. 6) GAMPRT(I) = .0000
00677         IF(I.EQ. 7) GAMPRT(I) = .0000
00678         IF(I.EQ. 8) GAMPRT(I) = 1.0000
00679         IF(I.EQ. 9) GAMPRT(I) = 1.0000
00680         IF(I.EQ.10) GAMPRT(I) = 1.0000
00681         IF(I.EQ.11) GAMPRT(I) = 1.0000
00682         IF(I.EQ.12) GAMPRT(I) = 1.0000
00683         IF(I.EQ.13) GAMPRT(I) = 1.0000
00684         IF(I.EQ.14) GAMPRT(I) = 1.0000
00685         IF(I.EQ.15) GAMPRT(I) = 1.0000
00686         IF(I.EQ.16) GAMPRT(I) = 1.0000
00687         IF(I.EQ.17) GAMPRT(I) = 1.0000
00688         IF(I.EQ.18) GAMPRT(I) = 1.0000
00689         IF(I.EQ.19) GAMPRT(I) = 1.0000
00690       ELSE
00691         JLIST(I) = 0
00692         GAMPRT(I) = 0.
00693       ENDIF
00694    1  CONTINUE
00695 * --- COEFFICIENTS TO FIX RATIO OF:
00696 * --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
00697 * --- PROBABILITY OF K0 TO BE KS
00698 * --- PROBABILITY OF K0B TO BE KS
00699 * --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
00700 * --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
00701 * --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
00702 * --- NEGLECTS MASS-PHASE SPACE EFFECTS
00703       BRA1=0.5
00704       BRK0=0.5
00705       BRK0B=0.5
00706       BRKS=0.6667
00707       ELSE
00708 *     ====
00709 * LIST OF BRANCHING RATIOS
00710       NCHAN = 19
00711       DO 2 I = 1,30
00712       IF (I.LE.NCHAN) THEN
00713         JLIST(I) = I
00714         IF(I.EQ. 1) GAMPRT(I) = .0000
00715         IF(I.EQ. 2) GAMPRT(I) = .0000
00716         IF(I.EQ. 3) GAMPRT(I) = .0000
00717         IF(I.EQ. 4) GAMPRT(I) = .0000
00718         IF(I.EQ. 5) GAMPRT(I) = .0000
00719         IF(I.EQ. 6) GAMPRT(I) = .0000
00720         IF(I.EQ. 7) GAMPRT(I) = .0000
00721         IF(I.EQ. 8) GAMPRT(I) = 1.0000
00722         IF(I.EQ. 9) GAMPRT(I) = 1.0000
00723         IF(I.EQ.10) GAMPRT(I) = 1.0000
00724         IF(I.EQ.11) GAMPRT(I) = 1.0000
00725         IF(I.EQ.12) GAMPRT(I) = 1.0000
00726         IF(I.EQ.13) GAMPRT(I) = 1.0000
00727         IF(I.EQ.14) GAMPRT(I) = 1.0000
00728         IF(I.EQ.15) GAMPRT(I) = 1.0000
00729         IF(I.EQ.16) GAMPRT(I) = 1.0000
00730         IF(I.EQ.17) GAMPRT(I) = 1.0000
00731         IF(I.EQ.18) GAMPRT(I) = 1.0000
00732         IF(I.EQ.19) GAMPRT(I) = 1.0000
00733       ELSE
00734         JLIST(I) = 0
00735         GAMPRT(I) = 0.
00736       ENDIF
00737    2  CONTINUE
00738 * --- COEFFICIENTS TO FIX RATIO OF:
00739 * --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
00740 * --- PROBABILITY OF K0 TO BE KS
00741 * --- PROBABILITY OF K0B TO BE KS
00742 * --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
00743 * --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
00744 * --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
00745 * --- NEGLECTS MASS-PHASE SPACE EFFECTS
00746       BRA1=0.5
00747       BRK0=0.5
00748       BRK0B=0.5
00749       BRKS=0.6667
00750       ENDIF
00751 *     =====
00752       END
00753 #endif
00754 
00755       SUBROUTINE INIPHX(XK00)
00756 * ----------------------------------------------------------------------
00757 *     INITIALISATION OF PARAMETERS
00758 *     USED IN QED and/or GSW ROUTINES
00759 * ----------------------------------------------------------------------
00760       COMMON / QEDPRM /ALFINV,ALFPI,XK0
00761       REAL*8           ALFINV,ALFPI,XK0
00762       REAL*8 PI8,XK00
00763 *
00764       PI8    = 4.D0*DATAN(1.D0)
00765       ALFINV = 137.03604D0
00766       ALFPI  = 1D0/(ALFINV*PI8)
00767       XK0=XK00
00768       END
00769 
00770       SUBROUTINE INIMAS
00771 C ----------------------------------------------------------------------
00772 C     INITIALISATION OF MASSES
00773 C
00774 C     called by : KORALZ
00775 C ----------------------------------------------------------------------
00776       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00777      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00778      *                 ,AMK,AMKZ,AMKST,GAMKST
00779 *
00780       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00781      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00782      *                 ,AMK,AMKZ,AMKST,GAMKST
00783 C
00784 C IN-COMING / OUT-GOING  FERMION MASSES
00785       AMTAU  = 1.7842
00786 C --- tau mass must be the same as in the host program, what-so-ever
00787       AMTAU  = 1.777
00788       AMNUTA = 0.010
00789       AMEL   = 0.0005111
00790       AMNUE  = 0.0
00791       AMMU   = 0.105659 
00792       AMNUMU = 0.0
00793 *
00794 * MASSES USED IN TAU DECAYS
00795 #if defined (CePeCe)
00796       AMPIZ  = 0.134964
00797       AMPI   = 0.139568
00798       AMRO   = 0.773
00799       GAMRO  = 0.145
00800 *C    GAMRO  = 0.666
00801       AMA1   = 1.251
00802       GAMA1  = 0.599
00803       AMK    = 0.493667
00804       AMKZ   = 0.49772
00805       AMKST  = 0.8921
00806       GAMKST = 0.0513
00807 #elif defined (CLEO)
00808       AMPIZ  = 0.134964
00809       AMPI   = 0.139568
00810       AMRO   = 0.773
00811       GAMRO  = 0.145
00812 *C    GAMRO  = 0.666
00813       AMA1   = 1.251
00814       GAMA1  = 0.599
00815       AMK    = 0.493667
00816       AMKZ   = 0.49772
00817       AMKST  = 0.8921
00818       GAMKST = 0.0513
00819 C
00820 C
00821 C IN-COMING / OUT-GOING  FERMION MASSES
00822 !!      AMNUTA = PKORB(1,2)
00823 !!      AMNUE  = PKORB(1,4)
00824 !!      AMNUMU = PKORB(1,6)
00825 C
00826 C MASSES USED IN TAU DECAYS  Cleo settings
00827 !!      AMPIZ  = PKORB(1,7)
00828 !!      AMPI   = PKORB(1,8)
00829 !!      AMRO   = PKORB(1,9)
00830 !!      GAMRO  = PKORB(2,9)
00831       AMA1   = 1.275   !! PKORB(1,10)
00832       GAMA1  = 0.615   !! PKORB(2,10)
00833 !!      AMK    = PKORB(1,11)
00834 !!      AMKZ   = PKORB(1,12)
00835 !!      AMKST  = PKORB(1,13)
00836 !!      GAMKST = PKORB(2,13)
00837 C
00838 #elif defined (ALEPH)
00839       AMPIZ  = 0.134964
00840       AMPI   = 0.139568
00841       AMRO   = 0.7714
00842       GAMRO  = 0.153
00843 cam   AMRO   = 0.773
00844 cam   GAMRO  = 0.145
00845       AMA1   = 1.251! PMAS(LUCOMP(ia1),1)       ! AMA1   = 1.251
00846       GAMA1  = 0.599! PMAS(LUCOMP(ia1),2)       ! GAMA1  = 0.599
00847       print *,'INIMAS a1 mass= ',ama1,gama1
00848       AMK    = 0.493667
00849       AMKZ   = 0.49772
00850       AMKST  = 0.8921
00851       GAMKST = 0.0513
00852 #else
00853 #endif
00854 
00855       RETURN
00856       END
00857       subroutine bostdq(idir,vv,pp,q)
00858 *     *******************************
00859 c Boost along arbitrary vector v (see eg. J.D. Jacson, Classical 
00860 c Electrodynamics).
00861 c Four-vector pp is boosted from an actual frame to the rest frame 
00862 c of the four-vector v (for idir=1) or back (for idir=-1). 
00863 c q is a resulting four-vector.
00864 c Note: v must be time-like, pp may be arbitrary.
00865 c
00866 c Written by: Wieslaw Placzek            date: 22.07.1994
00867 c Last update: 3/29/95                     by: M.S.
00868 c 
00869       implicit DOUBLE PRECISION (a-h,o-z)
00870       parameter (nout=6)
00871       DOUBLE PRECISION v(4),p(4),q(4),pp(4),vv(4)  
00872       save
00873 !
00874       do 1 i=1,4
00875       v(i)=vv(i)
00876  1    p(i)=pp(i)
00877       amv=(v(4)**2-v(1)**2-v(2)**2-v(3)**2)
00878       if (amv.le.0d0) then
00879         write(6,*) 'bosstv: warning amv**2=',amv
00880       endif
00881       amv=sqrt(abs(amv))
00882       if (idir.eq.-1) then
00883         q(4)=( p(1)*v(1)+p(2)*v(2)+p(3)*v(3)+p(4)*v(4))/amv
00884         wsp =(q(4)+p(4))/(v(4)+amv)
00885       elseif (idir.eq.1) then
00886         q(4)=(-p(1)*v(1)-p(2)*v(2)-p(3)*v(3)+p(4)*v(4))/amv
00887         wsp =-(q(4)+p(4))/(v(4)+amv)
00888       else
00889         write(nout,*)' >>> boostv: wrong value of idir = ',idir
00890       endif
00891       q(1)=p(1)+wsp*v(1)
00892       q(2)=p(2)+wsp*v(2)
00893       q(3)=p(3)+wsp*v(3)
00894       end
00895         
00896 
00897 
00898 
00899 
00900 
00901 
00902 
00903 
00904 #if defined (ALEPH) 
00905       FUNCTION DILOGY(X)
00906 C     *****************
00907       IMPLICIT REAL*8(A-H,O-Z)
00908 CERN      C304      VERSION    29/07/71 DILOG        59                C
00909       Z=-1.64493406684822
00910       IF(X .LT.-1.0) GO TO 1
00911       IF(X .LE. 0.5) GO TO 2
00912       IF(X .EQ. 1.0) GO TO 3
00913       IF(X .LE. 2.0) GO TO 4
00914       Z=3.2898681336964
00915     1 T=1.0/X
00916       S=-0.5
00917       Z=Z-0.5* LOG(ABS(X))**2
00918       GO TO 5
00919     2 T=X
00920       S=0.5
00921       Z=0.
00922       GO TO 5
00923     3 DILOGY=1.64493406684822
00924       RETURN
00925     4 T=1.0-X
00926       S=-0.5
00927       Z=1.64493406684822 - LOG(X)* LOG(ABS(T))
00928     5 Y=2.66666666666666 *T+0.66666666666666
00929       B=      0.00000 00000 00001
00930       A=Y*B  +0.00000 00000 00004
00931       B=Y*A-B+0.00000 00000 00011
00932       A=Y*B-A+0.00000 00000 00037
00933       B=Y*A-B+0.00000 00000 00121
00934       A=Y*B-A+0.00000 00000 00398
00935       B=Y*A-B+0.00000 00000 01312
00936       A=Y*B-A+0.00000 00000 04342
00937       B=Y*A-B+0.00000 00000 14437
00938       A=Y*B-A+0.00000 00000 48274
00939       B=Y*A-B+0.00000 00001 62421
00940       A=Y*B-A+0.00000 00005 50291
00941       B=Y*A-B+0.00000 00018 79117
00942       A=Y*B-A+0.00000 00064 74338
00943       B=Y*A-B+0.00000 00225 36705
00944       A=Y*B-A+0.00000 00793 87055
00945       B=Y*A-B+0.00000 02835 75385
00946       A=Y*B-A+0.00000 10299 04264
00947       B=Y*A-B+0.00000 38163 29463
00948       A=Y*B-A+0.00001 44963 00557
00949       B=Y*A-B+0.00005 68178 22718
00950       A=Y*B-A+0.00023 20021 96094
00951       B=Y*A-B+0.00100 16274 96164
00952       A=Y*B-A+0.00468 63619 59447
00953       B=Y*A-B+0.02487 93229 24228
00954       A=Y*B-A+0.16607 30329 27855
00955       A=Y*A-B+1.93506 43008 6996
00956       DILOGY=S*T*(A-B)+Z
00957       RETURN
00958 C=======================================================================
00959 C===================END OF CPC PART ====================================
00960 C=======================================================================
00961       END
00962 #endif
Generated on Sun Oct 20 20:24:11 2013 for C++InterfacetoTauola by  doxygen 1.6.3