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