00001 PROGRAM TAUDEM
00002
00003
00004
00005
00006
00007
00008
00009
00010 COMMON / / BLAN(10000)
00011 CHARACTER*7 DNAME
00012 COMMON / INOUT / INUT,IOUT
00013 DNAME='KKPI'
00014
00015
00016 INUT=5
00017 IOUT=6
00018 OPEN(IOUT,FILE="./tauola.output")
00019 OPEN(INUT,FILE="./dane.dat")
00020 KTORY=1
00021 CALL DECTES(KTORY)
00022 KTORY=2
00023 CALL DECTES(KTORY)
00024 END
00025 SUBROUTINE DECTES(KTORY)
00026
00027 REAL POL(4)
00028 DOUBLE PRECISION HH(4)
00029
00030 COMMON / JAKI / JAK1,JAK2,JAKP,JAKM,KTOM
00031 COMMON / IDFC / IDFF
00032
00033 COMMON / INOUT / INUT,IOUT
00034
00035 COMMON / IDPART / IA1
00036
00037 COMMON /PTAU/ PTAU
00038 COMMON / TAURAD / XK0DEC,ITDKRC
00039 REAL*8 XK0DEC
00040 COMMON /TESTA1/ KEYA1
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054 NINP=INUT
00055 NOUT=IOUT
00056 3000 FORMAT(A80)
00057 3001 FORMAT(8I2)
00058 3002 FORMAT(I10)
00059 3003 FORMAT(F10.0)
00060 IF (KTORY.EQ.1) THEN
00061 READ( NINP,3000) TESTIT
00062 WRITE(NOUT,3000) TESTIT
00063 READ( NINP,3001) KAT1,KAT2,KAT3,KAT4,KAT5,KAT6
00064 READ( NINP,3002) NEVT,JAK1,JAK2,ITDKRC
00065 READ( NINP,3003) PTAU,XK0DEC
00066 ENDIF
00067
00068
00069 WRITE(NOUT,'(6A6/6I6)')
00070 $ 'KAT1','KAT2','KAT3','KAT4','KAT5','KAT6',
00071 $ KAT1 , KAT2 , KAT3 , KAT4 , KAT5 , KAT6
00072 WRITE(NOUT,'(4A12/4I12)')
00073 $ 'NEVT','JAK1','JAK2','ITDKRC',
00074 $ NEVT, JAK1 , JAK2 , ITDKRC
00075 WRITE(NOUT,'(2A12/2F12.6)')
00076 $ 'PTAU','XK0DEC',
00077 $ PTAU , XK0DEC
00078
00079 JAK=0
00080
00081
00082
00083 IF (KTORY.EQ.1) THEN
00084 IDFF=-15
00085 ELSE
00086 IDFF= 15
00087 ENDIF
00088
00089
00090 KTO=2
00091 IF (KTO.NE.2) THEN
00092 PRINT *, 'for the sake of these tests KTO has to be 2'
00093 PRINT *, 'to change tau- to tau+ change IDFF from -15 to 15'
00094 STOP
00095 ENDIF
00096
00097 POL(1)=0.
00098 POL(2)=0.
00099 POL(3)=.9
00100
00101
00102
00103 NEVTES=10
00104 NEVTES=NEVT
00105 PRINT *, 'NEVTES= ',NEVTES
00106 WRITE(IOUT,7011) KEYA1
00107
00108 IF (KTORY.EQ.1) THEN
00109 WRITE(IOUT,7001) JAK,IDFF,POL(3),PTAU
00110 ELSE
00111 WRITE(IOUT,7004) JAK,IDFF,POL(3),PTAU
00112 ENDIF
00113
00114
00115 CALL INIMAS
00116 CALL INITDK
00117
00118
00119 CALL INIPHY(0.1D0)
00120 IF (KTORY.EQ.1) THEN
00121 CALL DEXAY(-1,POL)
00122 ELSE
00123 CALL DEKAY(-1,HH)
00124 ENDIF
00125
00126
00127
00128 NEV=0
00129 DO 300 IEV=1,NEVTES
00130 NEV=NEV+1
00131
00132 #if defined (history)
00133 CALL RESLU
00134 #else
00135 #endif
00136 CALL TAUFIL
00137
00138 IF (KTORY.EQ.1) THEN
00139 CALL DEXAY(KTO,POL)
00140 ELSE
00141 CALL DEKAY(KTO,HH)
00142 CALL DEKAY(KTO+10,HH)
00143 ENDIF
00144 CALL LUHEPC(2)
00145 IF(IEV.LE.44) THEN
00146 WRITE(IOUT,7002) IEV
00147 IF (KTORY.NE.1) THEN
00148 WRITE(IOUT,7003) HH
00149 ENDIF
00150
00151 CALL LULIST(2)
00152 ENDIF
00153 IPRI=MOD(NEV,1000)
00154 IF(IPRI.EQ.1) PRINT *, ' event no: ',NEV,' NEVTES: ',NEVTES
00155 300 CONTINUE
00156 301 CONTINUE
00157
00158
00159
00160 IF (KTORY.EQ.1) THEN
00161 CALL DEXAY(100,POL)
00162 ELSE
00163 CALL DEKAY(100,HH)
00164 ENDIF
00165 RETURN
00166 7001 FORMAT(//4(/1X,15(5H=====))
00167 $ /,' ', 19X,' TEST OF RAD. CORR IN ELECTRON DECAY ',9X,1H ,
00168 $ /,' ', 19X,' TESTS OF TAU DECAY ROUTINES ',9X,1H ,
00169 $ /,' ', 19X,' INTERFACE OF THE KORAL-Z TYPE ',9X,1H ,
00170 $ 2(/,1X,15(5H=====)),
00171 $ /,5X ,'JAK =',I7 ,' KEY DEFINING DECAY TYPE ',9X,1H ,
00172 $ /,5X ,'IDFF =',I7 ,' LUND IDENTIFIER FOR FIRST TAU ',9X,1H ,
00173 $ /,5X ,'POL(3)=',F7.2,' THIRD COMPONENT OF TAU POLARIZ. ',9X,1H ,
00174 $ /,5X ,'PTAU =',F7.2,' THIRD COMPONENT OF TAU MOM. GEV ',9X,1H ,
00175 $ 2(/,1X,15(5H=====))/)
00176 7002 FORMAT(///1X, '===== EVENT NO.',I4,1X,5H=====)
00177 7003 FORMAT(5X,'POLARIMETRIC VECTOR: ',
00178 $ 7X,'HH(1)',7X,'HH(2)',7X,'HH(3)',7X,'HH(4)',
00179 $ /, 5X,' ', 4(1X,F11.8) )
00180 7004 FORMAT(//4(/1X,15(5H=====))
00181 $ /,' ', 19X,' TEST OF RAD. CORR IN ELECTRON DECAY ',9X,1H ,
00182 $ /,' ', 19X,' TESTS OF TAU DECAY ROUTINES ',9X,1H ,
00183 $ /,' ', 19X,' INTERFACE OF THE KORAL-B TYPE ',9X,1H ,
00184 $ 2(/,1X,15(5H=====)),
00185 $ /,5X ,'JAK =',I7 ,' KEY DEFINING DECAY TYPE ',9X,1H ,
00186 $ /,5X ,'IDFF =',I7 ,' LUND IDENTIFIER FOR FIRST TAU ',9X,1H ,
00187 $ /,5X ,'POL(3)=',F7.2,' THIRD COMPONENT OF TAU POLARIZ. ',9X,1H ,
00188 $ /,5X ,'PTAU =',F7.2,' THIRD COMPONENT OF TAU MOM. GEV ',9X,1H ,
00189 $ 2(/,1X,15(5H=====))/)
00190 7011 FORMAT(///1X, '===== TYPE OF CURRENT',I4,1X,5H=====)
00191 END
00192 SUBROUTINE CHOICE(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
00193 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
00194 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00195 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00196 * ,AMK,AMKZ,AMKST,GAMKST
00197
00198 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00199 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00200 * ,AMK,AMKZ,AMKST,GAMKST
00201
00202 AMROP=1.1
00203 GAMROP=0.36
00204 AMOM=.782
00205 GAMOM=0.0084
00206
00207 IF(MNUM.EQ.0) THEN
00208 PROB1=0.5
00209 PROB2=0.5
00210 AMRX =AMA1
00211 GAMRX=GAMA1
00212 AMRA =AMRO
00213 GAMRA=GAMRO
00214 AMRB =AMRO
00215 GAMRB=GAMRO
00216 ELSEIF(MNUM.EQ.1) THEN
00217 PROB1=0.5
00218 PROB2=0.5
00219 AMRX =1.57
00220 GAMRX=0.9
00221 AMRB =AMKST
00222 GAMRB=GAMKST
00223 AMRA =AMRO
00224 GAMRA=GAMRO
00225 ELSEIF(MNUM.EQ.2) THEN
00226 PROB1=0.5
00227 PROB2=0.5
00228 AMRX =1.57
00229 GAMRX=0.9
00230 AMRB =AMKST
00231 GAMRB=GAMKST
00232 AMRA =AMRO
00233 GAMRA=GAMRO
00234 ELSEIF(MNUM.EQ.3) THEN
00235 PROB1=0.5
00236 PROB2=0.5
00237 AMRX =1.27
00238 GAMRX=0.3
00239 AMRA =AMKST
00240 GAMRA=GAMKST
00241 AMRB =AMKST
00242 GAMRB=GAMKST
00243 ELSEIF(MNUM.EQ.4) THEN
00244 PROB1=0.5
00245 PROB2=0.5
00246 AMRX =1.27
00247 GAMRX=0.3
00248 AMRA =AMKST
00249 GAMRA=GAMKST
00250 AMRB =AMKST
00251 GAMRB=GAMKST
00252 ELSEIF(MNUM.EQ.5) THEN
00253 PROB1=0.5
00254 PROB2=0.5
00255 AMRX =1.27
00256 GAMRX=0.3
00257 AMRA =AMKST
00258 GAMRA=GAMKST
00259 AMRB =AMRO
00260 GAMRB=GAMRO
00261 ELSEIF(MNUM.EQ.6) THEN
00262 PROB1=0.4
00263 PROB2=0.4
00264 AMRX =1.27
00265 GAMRX=0.3
00266 AMRA =AMRO
00267 GAMRA=GAMRO
00268 AMRB =AMKST
00269 GAMRB=GAMKST
00270 ELSEIF(MNUM.EQ.7) THEN
00271 PROB1=0.0
00272 PROB2=1.0
00273 AMRX =1.27
00274 GAMRX=0.9
00275 AMRA =AMRO
00276 GAMRA=GAMRO
00277 AMRB =AMRO
00278 GAMRB=GAMRO
00279 ELSEIF(MNUM.EQ.8) THEN
00280 PROB1=0.0
00281 PROB2=1.0
00282 AMRX =AMROP
00283 GAMRX=GAMROP
00284 AMRB =AMOM
00285 GAMRB=GAMOM
00286 AMRA =AMRO
00287 GAMRA=GAMRO
00288 ELSEIF(MNUM.EQ.101) THEN
00289 PROB1=.35
00290 PROB2=.35
00291 AMRX =1.2
00292 GAMRX=.46
00293 AMRB =AMOM
00294 GAMRB=GAMOM
00295 AMRA =AMOM
00296 GAMRA=GAMOM
00297 ELSEIF(MNUM.EQ.102) THEN
00298 PROB1=0.0
00299 PROB2=0.0
00300 AMRX =1.4
00301 GAMRX=.6
00302 AMRB =AMOM
00303 GAMRB=GAMOM
00304 AMRA =AMOM
00305 GAMRA=GAMOM
00306 ELSE
00307 PROB1=0.0
00308 PROB2=0.0
00309 AMRX =AMA1
00310 GAMRX=GAMA1
00311 AMRA =AMRO
00312 GAMRA=GAMRO
00313 AMRB =AMRO
00314 GAMRB=GAMRO
00315 ENDIF
00316
00317 IF (RR.LE.PROB1) THEN
00318 ICHAN=1
00319 ELSEIF(RR.LE.(PROB1+PROB2)) THEN
00320 ICHAN=2
00321 AX =AMRA
00322 GX =GAMRA
00323 AMRA =AMRB
00324 GAMRA=GAMRB
00325 AMRB =AX
00326 GAMRB=GX
00327 PX =PROB1
00328 PROB1=PROB2
00329 PROB2=PX
00330 ELSE
00331 ICHAN=3
00332 ENDIF
00333
00334 PROB3=1.0-PROB1-PROB2
00335 END
00336 SUBROUTINE INITDK
00337
00338
00339
00340
00341
00342
00343 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00344 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00345 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00346 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00347 * ,AMK,AMKZ,AMKST,GAMKST
00348
00349 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00350 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00351 * ,AMK,AMKZ,AMKST,GAMKST
00352 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00353 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00354 REAL*4 BRA1,BRK0,BRK0B,BRKS
00355 #if defined (ALEPH)
00356 PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3)
00357 COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE)
00358 & ,NAMES
00359 CHARACTER NAMES(NMODE)*31
00360 #else
00361 PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3)
00362 COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE)
00363 & ,NAMES
00364 CHARACTER NAMES(NMODE)*31
00365 #endif
00366 CHARACTER OLDNAMES(7)*31
00367 CHARACTER*80 bxINIT
00368 PARAMETER (
00369 $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
00370 $ )
00371 REAL*4 PI,POL1(4)
00372
00373
00374
00375
00376
00377
00378 #if defined (ALEPH)
00379
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392
00393
00394
00395
00396
00397
00398
00399
00400
00401
00402
00403
00404
00405
00406
00407
00408
00409
00410
00411
00412
00413
00414
00415
00416
00417
00418
00419
00420
00421
00422
00423
00424
00425 #else
00426
00427
00428
00429
00430
00431
00432
00433
00434
00435
00436
00437
00438 #endif
00439
00440 DIMENSION NOPIK(6,NMODE),NPIK(NMODE)
00441
00442 DATA NPIK / 4, 4,
00443 1 5, 5,
00444 2 6, 6,
00445 3 3, 3,
00446 4 3, 3,
00447 5 3, 3,
00448 6 3, 3,
00449 7 2 /
00450 #if defined (ALEPH)
00451 DATA NOPIK / -1,-1, 2, 1, 0, 0, 2, 2, 2,-1, 0, 0,
00452 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
00453 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
00454 3 -3,-1, 3, 0, 0, 0, 4,-1,-4, 0, 0, 0,
00455 4 -3, 2, 4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
00456 5 -3,-1, 1, 0, 0, 0, -1,-4, 2, 0, 0, 0,
00457 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
00458 #else
00459 DATA NOPIK / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
00460 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
00461 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
00462 3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
00463 4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
00464 5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
00465 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
00466 #endif
00467 #if defined (CLEO)
00468
00469 7 -3,-4, 0, 0, 0, 0 /
00470 #else
00471 7 -3, 4, 0, 0, 0, 0 /
00472 #endif
00473
00474 NCHAN = NMODE + 7
00475 DO 1 I = 1,30
00476 IF (I.LE.NCHAN) THEN
00477 JLIST(I) = I
00478 #if defined (CePeCe)
00479 IF(I.EQ. 1) GAMPRT(I) = 1.0000
00480 IF(I.EQ. 2) GAMPRT(I) = 1.0000
00481 IF(I.EQ. 3) GAMPRT(I) = 1.0000
00482 IF(I.EQ. 4) GAMPRT(I) = 1.0000
00483 IF(I.EQ. 5) GAMPRT(I) = 1.0000
00484 IF(I.EQ. 6) GAMPRT(I) = 1.0000
00485 IF(I.EQ. 7) GAMPRT(I) = 1.0000
00486 IF(I.EQ. 8) GAMPRT(I) = 1.0000
00487 IF(I.EQ. 9) GAMPRT(I) = 1.0000
00488 IF(I.EQ.10) GAMPRT(I) = 1.0000
00489 IF(I.EQ.11) GAMPRT(I) = 1.0000
00490 IF(I.EQ.12) GAMPRT(I) = 1.0000
00491 IF(I.EQ.13) GAMPRT(I) = 1.0000
00492 IF(I.EQ.14) GAMPRT(I) = 1.0000
00493 IF(I.EQ.15) GAMPRT(I) = 1.0000
00494 IF(I.EQ.16) GAMPRT(I) = 1.0000
00495 IF(I.EQ.17) GAMPRT(I) = 1.0000
00496 IF(I.EQ.18) GAMPRT(I) = 1.0000
00497 IF(I.EQ.19) GAMPRT(I) = 1.0000
00498 IF(I.EQ.20) GAMPRT(I) = 1.0000
00499 IF(I.EQ.21) GAMPRT(I) = 1.0000
00500 IF(I.EQ.22) GAMPRT(I) = 1.0000
00501 #elif defined (CLEO)
00502 IF(I.EQ. 1) GAMPRT(I) =0.1800
00503 IF(I.EQ. 2) GAMPRT(I) =0.1751
00504 IF(I.EQ. 3) GAMPRT(I) =0.1110
00505 IF(I.EQ. 4) GAMPRT(I) =0.2515
00506 IF(I.EQ. 5) GAMPRT(I) =0.1790
00507 IF(I.EQ. 6) GAMPRT(I) =0.0071
00508 IF(I.EQ. 7) GAMPRT(I) =0.0134
00509 IF(I.EQ. 8) GAMPRT(I) =0.0450
00510 IF(I.EQ. 9) GAMPRT(I) =0.0100
00511 IF(I.EQ.10) GAMPRT(I) =0.0009
00512 IF(I.EQ.11) GAMPRT(I) =0.0004
00513 IF(I.EQ.12) GAMPRT(I) =0.0003
00514 IF(I.EQ.13) GAMPRT(I) =0.0005
00515 IF(I.EQ.14) GAMPRT(I) =0.0015
00516 IF(I.EQ.15) GAMPRT(I) =0.0015
00517 IF(I.EQ.16) GAMPRT(I) =0.0015
00518 IF(I.EQ.17) GAMPRT(I) =0.0005
00519 IF(I.EQ.18) GAMPRT(I) =0.0050
00520 IF(I.EQ.19) GAMPRT(I) =0.0055
00521 IF(I.EQ.20) GAMPRT(I) =0.0017
00522 IF(I.EQ.21) GAMPRT(I) =0.0013
00523 IF(I.EQ.22) GAMPRT(I) =0.0010
00524 #elif defined (ALEPH)
00525 IF(I.EQ. 1) GAMPRT(I) = 1.0000
00526 IF(I.EQ. 2) GAMPRT(I) = .9732
00527 IF(I.EQ. 3) GAMPRT(I) = .6217
00528 IF(I.EQ. 4) GAMPRT(I) = 1.4221
00529 IF(I.EQ. 5) GAMPRT(I) = 1.0180
00530 IF(I.EQ. 6) GAMPRT(I) = .0405
00531 IF(I.EQ. 7) GAMPRT(I) = .0781
00532 IF(I.EQ. 8) GAMPRT(I) = .2414
00533 IF(I.EQ. 9) GAMPRT(I) = .0601
00534 IF(I.EQ.10) GAMPRT(I) = .0281
00535 IF(I.EQ.11) GAMPRT(I) = .0045
00536 IF(I.EQ.12) GAMPRT(I) = .0010
00537 IF(I.EQ.13) GAMPRT(I) = .0062
00538 IF(I.EQ.14) GAMPRT(I) = .0096
00539 IF(I.EQ.15) GAMPRT(I) = .0169
00540 IF(I.EQ.16) GAMPRT(I) = .0056
00541 IF(I.EQ.17) GAMPRT(I) = .0045
00542 IF(I.EQ.18) GAMPRT(I) = .0219
00543 IF(I.EQ.19) GAMPRT(I) = .0180
00544 IF(I.EQ.20) GAMPRT(I) = .0096
00545 IF(I.EQ.21) GAMPRT(I) = .0088
00546 IF(I.EQ.22) GAMPRT(I) = .0146
00547 #else
00548 #endif
00549 IF(I.EQ. 1) OLDNAMES(I)=' TAU- --> E- '
00550 IF(I.EQ. 2) OLDNAMES(I)=' TAU- --> MU- '
00551 IF(I.EQ. 3) OLDNAMES(I)=' TAU- --> PI- '
00552 IF(I.EQ. 4) OLDNAMES(I)=' TAU- --> PI-, PI0 '
00553 IF(I.EQ. 5) OLDNAMES(I)=' TAU- --> A1- (two subch) '
00554 IF(I.EQ. 6) OLDNAMES(I)=' TAU- --> K- '
00555 IF(I.EQ. 7) OLDNAMES(I)=' TAU- --> K*- (two subch) '
00556 IF(I.EQ. 8) NAMES(I-7)=' TAU- --> 2PI-, PI0, PI+ '
00557 IF(I.EQ. 9) NAMES(I-7)=' TAU- --> 3PI0, PI- '
00558 IF(I.EQ.10) NAMES(I-7)=' TAU- --> 2PI-, PI+, 2PI0 '
00559 IF(I.EQ.11) NAMES(I-7)=' TAU- --> 3PI-, 2PI+, '
00560 IF(I.EQ.12) NAMES(I-7)=' TAU- --> 3PI-, 2PI+, PI0 '
00561 IF(I.EQ.13) NAMES(I-7)=' TAU- --> 2PI-, PI+, 3PI0 '
00562 IF(I.EQ.14) NAMES(I-7)=' TAU- --> K-, PI-, K+ '
00563 IF(I.EQ.15) NAMES(I-7)=' TAU- --> K0, PI-, K0B '
00564 #if defined (ALEPH)
00565 IF(I.EQ.16) NAMES(I-7)=' TAU- --> K- PI0 K0 '
00566 #else
00567 IF(I.EQ.16) NAMES(I-7)=' TAU- --> K-, K0, PI0 '
00568 #endif
00569 IF(I.EQ.17) NAMES(I-7)=' TAU- --> PI0 PI0 K- '
00570 IF(I.EQ.18) NAMES(I-7)=' TAU- --> K- PI- PI+ '
00571 IF(I.EQ.19) NAMES(I-7)=' TAU- --> PI- K0B PI0 '
00572 IF(I.EQ.20) NAMES(I-7)=' TAU- --> ETA PI- PI0 '
00573 IF(I.EQ.21) NAMES(I-7)=' TAU- --> PI- PI0 GAM '
00574 IF(I.EQ.22) NAMES(I-7)=' TAU- --> K- K0 '
00575 ELSE
00576 JLIST(I) = 0
00577 GAMPRT(I) = 0.
00578 ENDIF
00579 1 CONTINUE
00580 DO I=1,NMODE
00581 MULPIK(I)=NPIK(I)
00582 DO J=1,MULPIK(I)
00583 IDFFIN(J,I)=NOPIK(J,I)
00584 ENDDO
00585 ENDDO
00586
00587
00588
00589
00590
00591
00592
00593
00594
00595
00596 BRA1=0.5
00597 BRK0=0.5
00598 BRK0B=0.5
00599 BRKS=0.6667
00600
00601
00602 GFERMI = 1.16637E-5
00603 CCABIB = 0.975
00604 GV = 1.0
00605 GA =-1.0
00606
00607
00608
00609
00610 SCABIB = SQRT(1.-CCABIB**2)
00611 PI =4.*ATAN(1.)
00612 GAMEL = GFERMI**2*AMTAU**5/(192*PI**3)
00613
00614
00615
00616 RETURN
00617 END
00618 FUNCTION DCDMAS(IDENT)
00619 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00620 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00621 * ,AMK,AMKZ,AMKST,GAMKST
00622
00623 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00624 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00625 * ,AMK,AMKZ,AMKST,GAMKST
00626 IF (IDENT.EQ. 1) THEN
00627 APKMAS=AMPI
00628 ELSEIF (IDENT.EQ.-1) THEN
00629 APKMAS=AMPI
00630 ELSEIF (IDENT.EQ. 2) THEN
00631 APKMAS=AMPIZ
00632 ELSEIF (IDENT.EQ.-2) THEN
00633 APKMAS=AMPIZ
00634 ELSEIF (IDENT.EQ. 3) THEN
00635 APKMAS=AMK
00636 ELSEIF (IDENT.EQ.-3) THEN
00637 APKMAS=AMK
00638 ELSEIF (IDENT.EQ. 4) THEN
00639 APKMAS=AMKZ
00640 ELSEIF (IDENT.EQ.-4) THEN
00641 APKMAS=AMKZ
00642 ELSEIF (IDENT.EQ. 8) THEN
00643 APKMAS=0.0001
00644 ELSEIF (IDENT.EQ.-8) THEN
00645 APKMAS=0.0001
00646 ELSEIF (IDENT.EQ. 9) THEN
00647 APKMAS=0.5488
00648 ELSEIF (IDENT.EQ.-9) THEN
00649 APKMAS=0.5488
00650 ELSE
00651 PRINT *, 'STOP IN APKMAS, WRONG IDENT=',IDENT
00652 STOP
00653 ENDIF
00654 DCDMAS=APKMAS
00655 END
00656 FUNCTION LUNPIK(ID,ISGN)
00657 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00658 REAL*4 BRA1,BRK0,BRK0B,BRKS
00659 REAL*4 XIO(1)
00660 IDENT=ID*ISGN
00661 #if defined (ALEPH)
00662 IF (IDENT.EQ. 1) THEN
00663 IPKDEF= 211
00664 ELSEIF (IDENT.EQ.-1) THEN
00665 IPKDEF=-211
00666 ELSEIF (IDENT.EQ. 2) THEN
00667 IPKDEF= 111
00668 ELSEIF (IDENT.EQ.-2) THEN
00669 IPKDEF= 111
00670 ELSEIF (IDENT.EQ. 3) THEN
00671 IPKDEF= 321
00672 ELSEIF (IDENT.EQ.-3) THEN
00673 IPKDEF=-321
00674 #else
00675 IF (IDENT.EQ. 1) THEN
00676 IPKDEF=-211
00677 ELSEIF (IDENT.EQ.-1) THEN
00678 IPKDEF= 211
00679 ELSEIF (IDENT.EQ. 2) THEN
00680 IPKDEF=111
00681 ELSEIF (IDENT.EQ.-2) THEN
00682 IPKDEF=111
00683 ELSEIF (IDENT.EQ. 3) THEN
00684 IPKDEF=-321
00685 ELSEIF (IDENT.EQ.-3) THEN
00686 IPKDEF= 321
00687 #endif
00688 ELSEIF (IDENT.EQ. 4) THEN
00689
00690
00691 CALL RANMAR(XIO,1)
00692 IF (XIO(1).GT.BRK0) THEN
00693 IPKDEF= 130
00694 ELSE
00695 IPKDEF= 310
00696 ENDIF
00697 ELSEIF (IDENT.EQ.-4) THEN
00698
00699
00700 CALL RANMAR(XIO,1)
00701 IF (XIO(1).GT.BRK0B) THEN
00702 IPKDEF= 130
00703 ELSE
00704 IPKDEF= 310
00705 ENDIF
00706 ELSEIF (IDENT.EQ. 8) THEN
00707 IPKDEF= 22
00708 ELSEIF (IDENT.EQ.-8) THEN
00709 IPKDEF= 22
00710 ELSEIF (IDENT.EQ. 9) THEN
00711 IPKDEF= 221
00712 ELSEIF (IDENT.EQ.-9) THEN
00713 IPKDEF= 221
00714 ELSE
00715 PRINT *, 'STOP IN IPKDEF, WRONG IDENT=',IDENT
00716 STOP
00717 ENDIF
00718 LUNPIK=IPKDEF
00719 END
00720
00721
00722 #if defined (CLEO)
00723
00724 SUBROUTINE TAURDF(KTO)
00725
00726
00727
00728 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00729 REAL*4 BRA1,BRK0,BRK0B,BRKS
00730 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00731 IF (KTO.EQ.1) THEN
00732
00733
00734 BRA1 = PKORB(4,1)
00735 BRKS = PKORB(4,3)
00736 BRK0 = PKORB(4,5)
00737 BRK0B = PKORB(4,6)
00738 ELSE
00739
00740
00741 BRA1 = PKORB(4,2)
00742 BRKS = PKORB(4,4)
00743 BRK0 = PKORB(4,5)
00744 BRK0B = PKORB(4,6)
00745 ENDIF
00746
00747 END
00748 #else
00749
00750 SUBROUTINE TAURDF(KTO)
00751
00752
00753
00754 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
00755 REAL*4 BRA1,BRK0,BRK0B,BRKS
00756 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
00757 IF (KTO.EQ.1) THEN
00758
00759
00760 NCHAN = 19
00761 DO 1 I = 1,30
00762 IF (I.LE.NCHAN) THEN
00763 JLIST(I) = I
00764 IF(I.EQ. 1) GAMPRT(I) = .0000
00765 IF(I.EQ. 2) GAMPRT(I) = .0000
00766 IF(I.EQ. 3) GAMPRT(I) = .0000
00767 IF(I.EQ. 4) GAMPRT(I) = .0000
00768 IF(I.EQ. 5) GAMPRT(I) = .0000
00769 IF(I.EQ. 6) GAMPRT(I) = .0000
00770 IF(I.EQ. 7) GAMPRT(I) = .0000
00771 IF(I.EQ. 8) GAMPRT(I) = 1.0000
00772 IF(I.EQ. 9) GAMPRT(I) = 1.0000
00773 IF(I.EQ.10) GAMPRT(I) = 1.0000
00774 IF(I.EQ.11) GAMPRT(I) = 1.0000
00775 IF(I.EQ.12) GAMPRT(I) = 1.0000
00776 IF(I.EQ.13) GAMPRT(I) = 1.0000
00777 IF(I.EQ.14) GAMPRT(I) = 1.0000
00778 IF(I.EQ.15) GAMPRT(I) = 1.0000
00779 IF(I.EQ.16) GAMPRT(I) = 1.0000
00780 IF(I.EQ.17) GAMPRT(I) = 1.0000
00781 IF(I.EQ.18) GAMPRT(I) = 1.0000
00782 IF(I.EQ.19) GAMPRT(I) = 1.0000
00783 ELSE
00784 JLIST(I) = 0
00785 GAMPRT(I) = 0.
00786 ENDIF
00787 1 CONTINUE
00788
00789
00790
00791
00792
00793
00794
00795
00796 BRA1=0.5
00797 BRK0=0.5
00798 BRK0B=0.5
00799 BRKS=0.6667
00800 ELSE
00801
00802
00803 NCHAN = 19
00804 DO 2 I = 1,30
00805 IF (I.LE.NCHAN) THEN
00806 JLIST(I) = I
00807 IF(I.EQ. 1) GAMPRT(I) = .0000
00808 IF(I.EQ. 2) GAMPRT(I) = .0000
00809 IF(I.EQ. 3) GAMPRT(I) = .0000
00810 IF(I.EQ. 4) GAMPRT(I) = .0000
00811 IF(I.EQ. 5) GAMPRT(I) = .0000
00812 IF(I.EQ. 6) GAMPRT(I) = .0000
00813 IF(I.EQ. 7) GAMPRT(I) = .0000
00814 IF(I.EQ. 8) GAMPRT(I) = 1.0000
00815 IF(I.EQ. 9) GAMPRT(I) = 1.0000
00816 IF(I.EQ.10) GAMPRT(I) = 1.0000
00817 IF(I.EQ.11) GAMPRT(I) = 1.0000
00818 IF(I.EQ.12) GAMPRT(I) = 1.0000
00819 IF(I.EQ.13) GAMPRT(I) = 1.0000
00820 IF(I.EQ.14) GAMPRT(I) = 1.0000
00821 IF(I.EQ.15) GAMPRT(I) = 1.0000
00822 IF(I.EQ.16) GAMPRT(I) = 1.0000
00823 IF(I.EQ.17) GAMPRT(I) = 1.0000
00824 IF(I.EQ.18) GAMPRT(I) = 1.0000
00825 IF(I.EQ.19) GAMPRT(I) = 1.0000
00826 ELSE
00827 JLIST(I) = 0
00828 GAMPRT(I) = 0.
00829 ENDIF
00830 2 CONTINUE
00831
00832
00833
00834
00835
00836
00837
00838
00839 BRA1=0.5
00840 BRK0=0.5
00841 BRK0B=0.5
00842 BRKS=0.6667
00843 ENDIF
00844
00845 END
00846 #endif
00847
00848 SUBROUTINE INIPHY(XK00)
00849
00850
00851
00852
00853 COMMON / QEDPRM /ALFINV,ALFPI,XK0
00854 REAL*8 ALFINV,ALFPI,XK0
00855 REAL*8 PI8,XK00
00856
00857 PI8 = 4.D0*DATAN(1.D0)
00858 ALFINV = 137.03604D0
00859 ALFPI = 1D0/(ALFINV*PI8)
00860 XK0=XK00
00861 END
00862
00863 SUBROUTINE INIMAS
00864
00865
00866
00867
00868
00869 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00870 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00871 * ,AMK,AMKZ,AMKST,GAMKST
00872
00873 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00874 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00875 * ,AMK,AMKZ,AMKST,GAMKST
00876
00877
00878 AMTAU = 1.7842
00879
00880 AMTAU = 1.777
00881 AMNUTA = 0.010
00882 AMEL = 0.0005111
00883 AMNUE = 0.0
00884 AMMU = 0.105659
00885 AMNUMU = 0.0
00886
00887
00888 #if defined (CePeCe)
00889 AMPIZ = 0.134964
00890 AMPI = 0.139568
00891 AMRO = 0.773
00892 GAMRO = 0.145
00893
00894 AMA1 = 1.251
00895 GAMA1 = 0.599
00896 AMK = 0.493667
00897 AMKZ = 0.49772
00898 AMKST = 0.8921
00899 GAMKST = 0.0513
00900 #elif defined (CLEO)
00901 AMPIZ = 0.134964
00902 AMPI = 0.139568
00903 AMRO = 0.773
00904 GAMRO = 0.145
00905
00906 AMA1 = 1.251
00907 GAMA1 = 0.599
00908 AMK = 0.493667
00909 AMKZ = 0.49772
00910 AMKST = 0.8921
00911 GAMKST = 0.0513
00912
00913
00914
00915
00916
00917
00918
00919
00920
00921
00922
00923
00924 AMA1 = 1.275
00925 GAMA1 = 0.615
00926
00927
00928
00929
00930
00931 #elif defined (ALEPH)
00932 AMPIZ = 0.134964
00933 AMPI = 0.139568
00934 AMRO = 0.7714
00935 GAMRO = 0.153
00936
00937
00938 AMA1 = 1.251
00939 GAMA1 = 0.599
00940 print *,'INIMAS a1 mass= ',ama1,gama1
00941 AMK = 0.493667
00942 AMKZ = 0.49772
00943 AMKST = 0.8921
00944 GAMKST = 0.0513
00945 #else
00946 #endif
00947
00948 RETURN
00949 END
00950 SUBROUTINE TAUFIL
00951
00952
00953
00954 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00955 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00956 * ,AMK,AMKZ,AMKST,GAMKST
00957
00958 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00959 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00960 * ,AMK,AMKZ,AMKST,GAMKST
00961 COMMON / IDFC / IDFF
00962
00963
00964 COMMON /TAUPOS / NPA,NPB
00965 DIMENSION XPB1(4),XPB2(4),AQF1(4),AQF2(4)
00966
00967
00968 DO 4 K=1,3
00969 XPB1(K)=0.0
00970 XPB2(K)=0.0
00971 AQF1(K)=0.0
00972 AQF2(K)=0.0
00973 4 CONTINUE
00974 AQF1(4)=AMTAU
00975 AQF2(4)=AMTAU
00976
00977 CALL TRALO4(1,AQF1,AQF1,AM)
00978 CALL TRALO4(2,AQF2,AQF2,AM)
00979
00980 KFB1= 11*IDFF/IABS(IDFF)
00981 KFB2=-11*IDFF/IABS(IDFF)
00982 XPB1(4)= AQF1(4)
00983 XPB1(3)= AQF1(4)
00984 IF(AQF1(3).NE.0.0)
00985 $ XPB1(3)= AQF1(4)*AQF1(3)/ABS(AQF1(3))
00986 XPB2(4)= AQF2(4)
00987 XPB2(3)=-AQF2(4)
00988 IF(AQF2(3).NE.0.0)
00989 $ XPB2(3)= AQF2(4)*AQF2(3)/ABS(AQF2(3))
00990
00991 NPA=3
00992 NPB=4
00993
00994 CALL FILHEP( 1,3, KFB1,0,0,0,0,XPB1, AMEL,.TRUE.)
00995 CALL FILHEP( 2,3, KFB2,0,0,0,0,XPB2, AMEL,.TRUE.)
00996 CALL FILHEP(NPA,1, IDFF,1,2,0,0,AQF1,AMTAU,.TRUE.)
00997 CALL FILHEP(NPB,1,-IDFF,1,2,0,0,AQF2,AMTAU,.TRUE.)
00998 END
00999 SUBROUTINE TRALO4(KTO,P,Q,AM)
01000
01001
01002 REAL P(4),Q(4)
01003
01004 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
01005 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
01006 * ,AMK,AMKZ,AMKST,GAMKST
01007
01008 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
01009 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
01010 * ,AMK,AMKZ,AMKST,GAMKST
01011 COMMON /PTAU/ PTAU
01012 AM=AMAS4(P)
01013 ETAU=SQRT(PTAU**2+AMTAU**2)
01014 EXE=(ETAU+PTAU)/AMTAU
01015 IF(KTO.EQ.2) EXE=(ETAU-PTAU)/AMTAU
01016 CALL BOSTR3(EXE,P,Q)
01017
01018
01019
01020 END
01021 SUBROUTINE FILHEP(N,IST,ID,JMO1,JMO2,JDA1,JDA2,P4,PINV,PHFLAG)
01022
01023
01024
01025
01026
01027
01028
01029
01030
01031 #include "../../include/HEPEVT.h"
01032
01033
01034
01035
01036
01037
01038
01039 LOGICAL PHFLAG
01040
01041 REAL*4 P4(4)
01042
01043
01044 IF (N.EQ.0) THEN
01045
01046
01047 IHEP=NHEP+1
01048 ELSE IF (N.GT.0) THEN
01049
01050
01051 IHEP=N
01052 ELSE
01053
01054
01055 IHEP=NHEP+N
01056 END IF
01057
01058
01059 IF ((IHEP.LE.0).OR.(IHEP.GT.NMXHEP)) RETURN
01060
01061
01062 NHEP=IHEP
01063 ISTHEP(IHEP)=IST
01064 IDHEP(IHEP)=ID
01065 JMOHEP(1,IHEP)=JMO1
01066 IF(JMO1.LT.0)JMOHEP(1,IHEP)=JMOHEP(1,IHEP)+IHEP
01067 JMOHEP(2,IHEP)=JMO2
01068 IF(JMO2.LT.0)JMOHEP(2,IHEP)=JMOHEP(2,IHEP)+IHEP
01069 JDAHEP(1,IHEP)=JDA1
01070 JDAHEP(2,IHEP)=JDA2
01071
01072 DO I=1,4
01073 PHEP(I,IHEP)=P4(I)
01074
01075
01076 VHEP(I,IHEP)=0.0
01077 END DO
01078 PHEP(5,IHEP)=PINV
01079
01080 QEDRAD(IHEP)=PHFLAG
01081
01082
01083 DO IP=JMOHEP(1,IHEP),JMOHEP(2,IHEP)
01084 IF(IP.GT.0)THEN
01085
01086
01087 IF(ISTHEP(IP).EQ.1)ISTHEP(IP)=2
01088
01089
01090 IF(JDAHEP(1,IP).EQ.0)THEN
01091 JDAHEP(1,IP)=IHEP
01092 JDAHEP(2,IP)=IHEP
01093 ELSE
01094 JDAHEP(2,IP)=MAX(IHEP,JDAHEP(2,IP))
01095 END IF
01096 END IF
01097 END DO
01098
01099 RETURN
01100 END
01101 #if defined (ALEPH)
01102 FUNCTION DILOGY(X)
01103
01104 IMPLICIT REAL*8(A-H,O-Z)
01105
01106 Z=-1.64493406684822
01107 IF(X .LT.-1.0) GO TO 1
01108 IF(X .LE. 0.5) GO TO 2
01109 IF(X .EQ. 1.0) GO TO 3
01110 IF(X .LE. 2.0) GO TO 4
01111 Z=3.2898681336964
01112 1 T=1.0/X
01113 S=-0.5
01114 Z=Z-0.5* LOG(ABS(X))**2
01115 GO TO 5
01116 2 T=X
01117 S=0.5
01118 Z=0.
01119 GO TO 5
01120 3 DILOGY=1.64493406684822
01121 RETURN
01122 4 T=1.0-X
01123 S=-0.5
01124 Z=1.64493406684822 - LOG(X)* LOG(ABS(T))
01125 5 Y=2.66666666666666 *T+0.66666666666666
01126 B= 0.00000 00000 00001
01127 A=Y*B +0.00000 00000 00004
01128 B=Y*A-B+0.00000 00000 00011
01129 A=Y*B-A+0.00000 00000 00037
01130 B=Y*A-B+0.00000 00000 00121
01131 A=Y*B-A+0.00000 00000 00398
01132 B=Y*A-B+0.00000 00000 01312
01133 A=Y*B-A+0.00000 00000 04342
01134 B=Y*A-B+0.00000 00000 14437
01135 A=Y*B-A+0.00000 00000 48274
01136 B=Y*A-B+0.00000 00001 62421
01137 A=Y*B-A+0.00000 00005 50291
01138 B=Y*A-B+0.00000 00018 79117
01139 A=Y*B-A+0.00000 00064 74338
01140 B=Y*A-B+0.00000 00225 36705
01141 A=Y*B-A+0.00000 00793 87055
01142 B=Y*A-B+0.00000 02835 75385
01143 A=Y*B-A+0.00000 10299 04264
01144 B=Y*A-B+0.00000 38163 29463
01145 A=Y*B-A+0.00001 44963 00557
01146 B=Y*A-B+0.00005 68178 22718
01147 A=Y*B-A+0.00023 20021 96094
01148 B=Y*A-B+0.00100 16274 96164
01149 A=Y*B-A+0.00468 63619 59447
01150 B=Y*A-B+0.02487 93229 24228
01151 A=Y*B-A+0.16607 30329 27855
01152 A=Y*A-B+1.93506 43008 6996
01153 DILOGY=S*T*(A-B)+Z
01154 RETURN
01155
01156
01157
01158 END
01159 #endif