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