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