10 COMMON / / blan(10000)
12 COMMON / inout / inut,iout
18 OPEN(iout,file=
"./tauola.output")
19 OPEN(inut,file=
"./dane.dat")
26 SUBROUTINE dectes(KTORY)
29 DOUBLE PRECISION HH(4)
31 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
34 COMMON / inout / inut,iout
39 COMMON / taurad / xk0dec,itdkrc
62 READ( ninp,3000) testit
63 WRITE(nout,3000) testit
64 READ( ninp,3001) kat1,kat2,kat3,kat4,kat5,kat6
65 READ( ninp,3002) nevt,jak1,jak2,itdkrc
66 READ( ninp,3003) ptau,xk0dec
70 WRITE(nout,
'(6A6/6I6)')
71 $
'KAT1',
'KAT2',
'KAT3',
'KAT4',
'KAT5',
'KAT6',
72 $ kat1 , kat2 , kat3 , kat4 , kat5 , kat6
73 WRITE(nout,
'(4A12/4I12)')
74 $
'NEVT',
'JAK1',
'JAK2',
'ITDKRC',
75 $ nevt, jak1 , jak2 , itdkrc
76 WRITE(nout,
'(2A12/2F12.6)')
93 print *,
'for the sake of these tests KTO has to be 2'
94 print *,
'to change tau- to tau+ change IDFF from -15 to 15'
106 print *,
'NEVTES= ',nevtes
107 WRITE(iout,7011) keya1
110 WRITE(iout,7001) jak,idff,pol(3),ptau
112 WRITE(iout,7004) jak,idff,pol(3),ptau
140 CALL dekay(kto+10,hh)
153 IF(ipri.EQ.1)
write(*,*)
' event no: ',nev,
' NEVTES: ',nevtes
165 7001
FORMAT(//4(/1x,15(5h=====))
166 $ /,
' ', 19x,
' NON INITIALIZED BBB-VERSION OF TAUOLA ',9x,1h ,
167 $ /,
' ', 19x,
' TESTS OF TAU DECAY ROUTINES ',9x,1h ,
168 $ /,
' ', 19x,
' INTERFACE OF THE KORAL-Z TYPE ',9x,1h ,
169 $ 2(/,1x,15(5h=====)),
170 $ /,5x ,
'JAK =',i7 ,
' KEY DEFINING DECAY TYPE ',9x,1h ,
171 $ /,5x ,
'IDFF =',i7 ,
' LUND IDENTIFIER FOR FIRST TAU ',9x,1h ,
172 $ /,5x ,
'POL(3)=',f7.2,
' THIRD COMPONENT OF TAU POLARIZ. ',9x,1h ,
173 $ /,5x ,
'PTAU =',f7.2,
' THIRD COMPONENT OF TAU MOM. GEV ',9x,1h ,
174 $ 2(/,1x,15(5h=====))/)
175 7002
FORMAT(///1x,
'===== EVENT NO.',i4,1x,5h=====)
176 7003
FORMAT(5x,
'POLARIMETRIC VECTOR: ',
177 $ 7x,
'HH(1)',7x,
'HH(2)',7x,
'HH(3)',7x,
'HH(4)',
178 $ /, 5x,
' ', 4(1x,f11.8) )
179 7004
FORMAT(//4(/1x,15(5h=====))
180 $ /,
' ', 19x,
' NON INITIALIZED BBB-VERSION OF TAUOLA ',9x,1h ,
181 $ /,
' ', 19x,
' TESTS OF TAU DECAY ROUTINES ',9x,1h ,
182 $ /,
' ', 19x,
' INTERFACE OF THE KORAL-B TYPE ',9x,1h ,
183 $ 2(/,1x,15(5h=====)),
184 $ /,5x ,
'JAK =',i7 ,
' KEY DEFINING DECAY TYPE ',9x,1h ,
185 $ /,5x ,
'IDFF =',i7 ,
' LUND IDENTIFIER FOR FIRST TAU ',9x,1h ,
186 $ /,5x ,
'POL(3)=',f7.2,
' THIRD COMPONENT OF TAU POLARIZ. ',9x,1h ,
187 $ /,5x ,
'PTAU =',f7.2,
' THIRD COMPONENT OF TAU MOM. GEV ',9x,1h ,
188 $ 2(/,1x,15(5h=====))/)
189 7011
FORMAT(///1x,
'===== TYPE OF CURRENT',i4,1x,5h=====)
191 SUBROUTINE choice(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
192 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
193 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
194 * ,ampiz,ampi,amro,gamro,ama1,gama1
195 * ,amk,amkz,amkst,gamkst
197 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
198 * ,ampiz,ampi,amro,gamro,ama1,gama1
199 * ,amk,amkz,amkst,gamkst
215 ELSEIF(mnum.EQ.1)
THEN
224 ELSEIF(mnum.EQ.2)
THEN
233 ELSEIF(mnum.EQ.3)
THEN
242 ELSEIF(mnum.EQ.4)
THEN
251 ELSEIF(mnum.EQ.5)
THEN
260 ELSEIF(mnum.EQ.6)
THEN
269 ELSEIF(mnum.EQ.7)
THEN
278 ELSEIF(mnum.EQ.8)
THEN
287 ELSEIF(mnum.EQ.9)
THEN
296 ELSEIF(mnum.EQ.101)
THEN
305 ELSEIF(mnum.EQ.102)
THEN
314 ELSEIF(mnum.GE.103.AND.mnum.LE.112)
THEN
336 IF (rr.LE.prob1)
THEN
338 ELSEIF(rr.LE.(prob1+prob2))
THEN
353 prob3=1.0-prob1-prob2
362 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
363 real*4 gfermi,gv,ga,ccabib,scabib,gamel
364 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
365 * ,ampiz,ampi,amro,gamro,ama1,gama1
366 * ,amk,amkz,amkst,gamkst
368 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
369 * ,ampiz,ampi,amro,gamro,ama1,gama1
370 * ,amk,amkz,amkst,gamkst
371 COMMON / taubra / gamprt(500),jlist(500),nchan
372 COMMON / taukle / bra1,brk0,brk0b,brks
373 real*4 bra1,brk0,brk0b,brks
375 parameter(nmode=86,nm1=0,nm2=11,nm3=19,nm4=22,nm5=21,nm6=13)
376 COMMON / taudcd /idffin(9,nmode),mulpik(nmode)
378 CHARACTER NAMES(NMODE)*31
380 CHARACTER OLDNAMES(7)*31
383 $ bxinit =
'(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
407 dimension nopik(9,nmode),npik(nmode)
455 DATA nopik / -1,-1, 1, 2, 0, 0,3*0, 2, 2, 2,-1, 0, 0,3*0,
456 a 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
457 b 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
458 c 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
459 d 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
460 e 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
461 a 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
462 b 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
463 c 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
464 d 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
465 e 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
466 1 -1,-1, 1, 2, 2, 0,3*0,
467 a -1,-1, 1, 2, 2, 0,3*0, 2, 2, 2, 2, 2, 0,3*0,
468 a 1,-1,-1, 2, 2, 0,3*0, -1, 2, 2, 2, 2, 0,3*0,
469 a -1, 1, 1,-1,-1, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
470 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
471 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
472 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
473 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
474 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
475 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
476 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
477 x -1,-1,-1, 1, 1, 0,3*0,
478 2 -1,-1,-1, 1, 1, 2,3*0, -1,-1, 1, 2, 2, 2,3*0,
479 a -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
480 b -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
481 c -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
482 d -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
483 e -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
484 3 -3,-1, 3, 0, 0, 0,3*0, -4,-1, 4, 0, 0, 0,3*0,
485 4 -3, 2,-4, 0, 0, 0,3*0, 2, 2,-3, 0, 0, 0,3*0,
486 5 -3,-1, 1, 0, 0, 0,3*0, -1, 4, 2, 0, 0, 0,3*0,
487 6 9,-1, 2, 0, 0, 0,3*0, -1, 2, 8, 0, 0, 0,3*0,
491 7 2, 2,-1, 0, 0, 0,3*0,
492 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
493 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
494 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
495 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
496 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
498 8 -3,-4, 0, 0, 0, 0,3*0,
499 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0,
500 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0,
501 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0,
502 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0,
503 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0 /
512 IF(i.EQ. 1) gamprt(i) =0.1800
513 IF(i.EQ. 2) gamprt(i) =0.1751
514 IF(i.EQ. 3) gamprt(i) =0.1110
515 IF(i.EQ. 4) gamprt(i) =0.2515
516 IF(i.EQ. 5) gamprt(i) =0.1790 /2
517 IF(i.EQ. 6) gamprt(i) =0.0071
518 IF(i.EQ. 7) gamprt(i) =0.0134
519 IF(i.EQ. 8) gamprt(i) =0.0450
520 IF(i.EQ. 9) gamprt(i) =0.0100
522 IF(i.EQ.30) gamprt(i) =0.0009
523 IF(i.EQ.33) gamprt(i) =0.004
524 IF(i.EQ.34) gamprt(i) =0.002
525 IF(i.EQ.35) gamprt(i) =0.001
527 IF(i.EQ.51) gamprt(i) =0.0004
528 IF(i.EQ.52) gamprt(i) =0.0003
529 IF(i.EQ.53) gamprt(i) =0.0005
531 IF(i.EQ.64) gamprt(i) =0.0015
532 IF(i.EQ.65) gamprt(i) =0.0015
533 IF(i.EQ.66) gamprt(i) =0.0015
534 IF(i.EQ.67) gamprt(i) =0.0005
535 IF(i.EQ.68) gamprt(i) =0.0050
536 IF(i.EQ.69) gamprt(i) =0.0055
537 IF(i.EQ.70) gamprt(i) =0.0017
538 IF(i.EQ.71) gamprt(i) =0.0013
539 IF(i.EQ.72) gamprt(i) =0.1790 /2
541 IF(i.EQ.83) gamprt(i) =0.0010
543 IF(i.EQ. 1) oldnames(i)=
' TAU- --> E- '
544 IF(i.EQ. 2) oldnames(i)=
' TAU- --> MU- '
545 IF(i.EQ. 3) oldnames(i)=
' TAU- --> PI- '
546 IF(i.EQ. 4) oldnames(i)=
' TAU- --> PI-, PI0 '
547 IF(i.EQ. 5) oldnames(i)=
' TAU- --> PI-, PI-, PI+ '
548 IF(i.EQ. 6) oldnames(i)=
' TAU- --> K- '
549 IF(i.EQ. 7) oldnames(i)=
' TAU- --> K*- (two subch) '
550 IF(i.EQ. 8) names(i-7)=
' TAU- --> 2PI-, PI0, PI+ '
551 IF(i.EQ. 9) names(i-7)=
' TAU- --> 3PI0, PI- '
553 IF(i.EQ.10) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
554 IF(i.EQ.11) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
555 IF(i.EQ.12) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
556 IF(i.EQ.13) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
557 IF(i.EQ.14) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
558 IF(i.EQ.15) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
559 IF(i.EQ.16) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
560 IF(i.EQ.17) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
561 IF(i.EQ.18) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
562 IF(i.EQ.19) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
563 IF(i.EQ.20) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
564 IF(i.EQ.21) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
565 IF(i.EQ.22) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
566 IF(i.EQ.23) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
567 IF(i.EQ.24) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
568 IF(i.EQ.25) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
569 IF(i.EQ.26) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
570 IF(i.EQ.27) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
571 IF(i.EQ.28) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
572 IF(i.EQ.29) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
575 IF(i.EQ.30) names(i-7)=
' TAU- --> 2PI-, PI+, 2PI0 old'
577 IF(i.EQ.31) names(i-7)=
' TAU- --> a1 --> rho omega '
578 IF(i.EQ.32) names(i-7)=
' TAU- --> benchmark curr '
579 IF(i.EQ.33) names(i-7)=
' TAU- --> 2PI0, 2PI-, PI+ '
580 IF(i.EQ.34) names(i-7)=
' TAU- --> PI- 4PI0 '
581 IF(i.EQ.35) names(i-7)=
' TAU- --> 3PI- 2PI+ '
582 IF(i.EQ.36) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
583 IF(i.EQ.37) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
584 IF(i.EQ.38) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
585 IF(i.EQ.39) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
586 IF(i.EQ.40) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
588 IF(i.EQ.41) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
589 IF(i.EQ.42) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
590 IF(i.EQ.43) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
591 IF(i.EQ.44) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
592 IF(i.EQ.45) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
593 IF(i.EQ.46) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
594 IF(i.EQ.47) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
595 IF(i.EQ.48) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
596 IF(i.EQ.49) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
597 IF(i.EQ.50) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
599 IF(i.EQ.51) names(i-7)=
' TAU- --> 3PI-, 2PI+, '
600 IF(i.EQ.52) names(i-7)=
' TAU- --> 3PI-, 2PI+, PI0 '
601 IF(i.EQ.53) names(i-7)=
' TAU- --> 2PI-, PI+, 3PI0 '
602 IF(i.EQ.54) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
603 IF(i.EQ.55) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
604 IF(i.EQ.56) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
605 IF(i.EQ.57) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
606 IF(i.EQ.58) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
607 IF(i.EQ.59) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
608 IF(i.EQ.60) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
609 IF(i.EQ.61) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
610 IF(i.EQ.62) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
611 IF(i.EQ.63) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
613 IF(i.EQ.64) names(i-7)=
' TAU- --> K-, PI-, K+ '
614 IF(i.EQ.65) names(i-7)=
' TAU- --> K0, PI-, K0B '
616 IF(i.EQ.66) names(i-7)=
' TAU- --> K-, K0, PI0 '
618 IF(i.EQ.67) names(i-7)=
' TAU- --> PI0 PI0 K- '
619 IF(i.EQ.68) names(i-7)=
' TAU- --> K- PI- PI+ '
620 IF(i.EQ.69) names(i-7)=
' TAU- --> PI- K0B PI0 '
621 IF(i.EQ.70) names(i-7)=
' TAU- --> ETA PI- PI0 '
622 IF(i.EQ.71) names(i-7)=
' TAU- --> PI- PI0 GAM '
623 IF(i.EQ.72) names(i-7)=
' TAU- --> PI- PI0 PI0 '
624 IF(i.EQ.73) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
625 IF(i.EQ.74) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
626 IF(i.EQ.75) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
627 IF(i.EQ.76) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
628 IF(i.EQ.77) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
629 IF(i.EQ.78) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
630 IF(i.EQ.79) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
631 IF(i.EQ.80) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
632 IF(i.EQ.81) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
633 IF(i.EQ.82) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
636 IF(i.EQ.83) names(i-7)=
' TAU- --> K- K0 '
637 IF(i.EQ.84) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
638 IF(i.EQ.85) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
639 IF(i.EQ.86) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
640 IF(i.EQ.87) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
641 IF(i.EQ.88) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
642 IF(i.EQ.89) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
643 IF(i.EQ.90) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
644 IF(i.EQ.91) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
645 IF(i.EQ.92) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
646 IF(i.EQ.93) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
656 idffin(j,i)=nopik(j,i)
660 gamprt(i) = 1d0/nchan
662 gamprt(31)=gamprt(31)*0.001
663 gamprt(32)=gamprt(32)*0.001
665 gamprt(36+k)=gamprt(36+k)*0.001
666 gamprt(30-k)=gamprt(30-k)*0.001
667 gamprt(30+10+k)=gamprt(30+10+k)*0.001
668 gamprt(30-10-k)=gamprt(30-10-k)*0.001
670 gamprt(53+k)=gamprt(53+k)*0.001
671 gamprt(72+k)=gamprt(72+k)*0.001
672 gamprt(83+k)=gamprt(83+k)*0.001
674 gamprt(72)=gamprt(72)/2
675 gamprt(5)=gamprt(5)/2
701 scabib = sqrt(1.-ccabib**2)
703 gamel = gfermi**2*amtau**5/(192*pi**3)
709 FUNCTION dcdmas(IDENT)
710 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
711 * ,ampiz,ampi,amro,gamro,ama1,gama1
712 * ,amk,amkz,amkst,gamkst
714 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
715 * ,ampiz,ampi,amro,gamro,ama1,gama1
716 * ,amk,amkz,amkst,gamkst
717 IF (ident.EQ. 1)
THEN
719 ELSEIF (ident.EQ.-1)
THEN
721 ELSEIF (ident.EQ. 2)
THEN
723 ELSEIF (ident.EQ.-2)
THEN
725 ELSEIF (ident.EQ. 3)
THEN
727 ELSEIF (ident.EQ.-3)
THEN
729 ELSEIF (ident.EQ. 4)
THEN
731 ELSEIF (ident.EQ.-4)
THEN
733 ELSEIF (ident.EQ. 8)
THEN
735 ELSEIF (ident.EQ.-8)
THEN
737 ELSEIF (ident.EQ. 9)
THEN
739 ELSEIF (ident.EQ.-9)
THEN
742 print *,
'STOP IN APKMAS, WRONG IDENT=',ident
747 FUNCTION lunpik(ID,ISGN)
748 COMMON / taukle / bra1,brk0,brk0b,brks
749 real*4 bra1,brk0,brk0b,brks
753 IF (ident.EQ. 1)
THEN
755 ELSEIF (ident.EQ.-1)
THEN
757 ELSEIF (ident.EQ. 2)
THEN
759 ELSEIF (ident.EQ.-2)
THEN
761 ELSEIF (ident.EQ. 3)
THEN
763 ELSEIF (ident.EQ.-3)
THEN
766 ELSEIF (ident.EQ. 4)
THEN
770 IF (xio(1).GT.brk0)
THEN
775 ELSEIF (ident.EQ.-4)
THEN
779 IF (xio(1).GT.brk0b)
THEN
784 ELSEIF (ident.EQ. 8)
THEN
786 ELSEIF (ident.EQ.-8)
THEN
788 ELSEIF (ident.EQ. 9)
THEN
790 ELSEIF (ident.EQ.-9)
THEN
793 print *,
'STOP IN IPKDEF, WRONG IDENT=',ident
802 SUBROUTINE taurdf(KTO)
806 COMMON / taukle / bra1,brk0,brk0b,brks
807 real*4 bra1,brk0,brk0b,brks
808 COMMON / taubra / gamprt(500),jlist(500),nchan
828 SUBROUTINE iniphy(XK00)
833 COMMON / qedprm /alfinv,alfpi,xk0
834 real*8 alfinv,alfpi,xk0
837 pi8 = 4.d0*datan(1.d0)
839 alfpi = 1d0/(alfinv*pi8)
849 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
850 * ,ampiz,ampi,amro,gamro,ama1,gama1
851 * ,amk,amkz,amkst,gamkst
853 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
854 * ,ampiz,ampi,amro,gamro,ama1,gama1
855 * ,amk,amkz,amkst,gamkst
907 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
908 * ,ampiz,ampi,amro,gamro,ama1,gama1
909 * ,amk,amkz,amkst,gamkst
911 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
912 * ,ampiz,ampi,amro,gamro,ama1,gama1
913 * ,amk,amkz,amkst,gamkst
917 COMMON /taupos / npa,npb
918 dimension xpb1(4),xpb2(4),aqf1(4),aqf2(4)
930 CALL tralo4(1,aqf1,aqf1,am)
931 CALL tralo4(2,aqf2,aqf2,am)
933 kfb1= 11*idff/iabs(idff)
934 kfb2=-11*idff/iabs(idff)
938 $ xpb1(3)= aqf1(4)*aqf1(3)/abs(aqf1(3))
942 $ xpb2(3)= aqf2(4)*aqf2(3)/abs(aqf2(3))
947 CALL filhep( 1,3, kfb1,0,0,0,0,xpb1, amel,.true.)
948 CALL filhep( 2,3, kfb2,0,0,0,0,xpb2, amel,.true.)
949 CALL filhep(npa,1, idff,1,2,0,0,aqf1,amtau,.true.)
950 CALL filhep(npb,1,-idff,1,2,0,0,aqf2,amtau,.true.)
952 SUBROUTINE tralo4(KTO,P,Q,AM)
957 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
958 * ,ampiz,ampi,amro,gamro,ama1,gama1
959 * ,amk,amkz,amkst,gamkst
961 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
962 * ,ampiz,ampi,amro,gamro,ama1,gama1
963 * ,amk,amkz,amkst,gamkst
966 etau=sqrt(ptau**2+amtau**2)
967 exe=(etau+ptau)/amtau
968 IF(kto.EQ.2) exe=(etau-ptau)/amtau
974 SUBROUTINE filhep(N,IST,ID,JMO1,JMO2,JDA1,JDA2,P4,PINV,PHFLAG)
984 #include "../../include/HEPEVT.h"
1001 ELSE IF (n.GT.0)
THEN
1012 IF ((ihep.LE.0).OR.(ihep.GT.nmxhep))
RETURN
1019 IF(jmo1.LT.0)jmohep(1,ihep)=jmohep(1,ihep)+ihep
1021 IF(jmo2.LT.0)jmohep(2,ihep)=jmohep(2,ihep)+ihep
1036 DO ip=jmohep(1,ihep),jmohep(2,ihep)
1040 IF(isthep(ip).EQ.1)isthep(ip)=2
1043 IF(jdahep(1,ip).EQ.0)
THEN
1047 jdahep(2,ip)=max(ihep,jdahep(2,ip))