7 SUBROUTINE inietc(jakk1,jakk2,itd,ifpho)
9 COMMON / taurad / xk0dec,itdkrc
10 DOUBLE PRECISION XK0DEC
11 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
12 COMMON /phoact/ ifphot
27 SUBROUTINE tralo4(KTOS,PHOI,PHOF,AM)
31 COMMON / momdec / q1,q2,p1,p2,p3,p4
33 double precision Q1(4),Q2(4),P1(4),P2(4),P3(4),P4(4),P1QQ(4),P2QQ(
34 double precision PIN(4),POUT(4),PBST(4),PBS1(4),QQ(4),PI
35 double precision THET,PHI,EXE
36 REAL*4 PHOI(4),PHOF(4)
38 DATA pi /3.141592653589793238462643d0/
40 $ (phoi(4)**2-phoi(3)**2-phoi(2)**2-phoi(1)**2))
52 ELSEIF(idtra.EQ.2)
THEN 57 ELSEIF(idtra.EQ.3)
THEN 71 CALL bostdq(1,qq,pbst,pbst)
72 CALL bostdq(1,qq,p1,p1qq)
73 CALL bostdq(1,qq,p2,p2qq)
75 pbs1(3)=sqrt(pbst(3)**2+pbst(2)**2+pbst(1)**2)
78 exe=(pbs1(4)+pbs1(3))/dsqrt(pbs1(4)**2-pbs1(3)**2)
82 IF(ktos.EQ.1) exe=(pbs1(4)-pbs1(3))/dsqrt(pbs1(4)**2-pbs1(3)**2)
83 CALL bostd3(exe,pin,pout)
86 thet=acos(p2qq(3)/sqrt(p2qq(3)**2+p2qq(2)**2+p2qq(1)**2))
88 phi=acos(p2qq(1)/sqrt(p2qq(2)**2+p2qq(1)**2))
89 IF(p2qq(2).LT.0d0) phi=2*pi-phi
91 CALL rotpox(thet,phi,pout)
92 CALL bostdq(-1,qq,pout,pout)
99 SUBROUTINE choice(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
100 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
101 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
102 * ,ampiz,ampi,amro,gamro,ama1,gama1
103 * ,amk,amkz,amkst,gamkst
105 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
106 * ,ampiz,ampi,amro,gamro,ama1,gama1
107 * ,amk,amkz,amkst,gamkst
123 ELSEIF(mnum.EQ.1)
THEN 132 ELSEIF(mnum.EQ.2)
THEN 141 ELSEIF(mnum.EQ.3)
THEN 150 ELSEIF(mnum.EQ.4)
THEN 159 ELSEIF(mnum.EQ.5)
THEN 168 ELSEIF(mnum.EQ.6)
THEN 177 ELSEIF(mnum.EQ.7)
THEN 186 ELSEIF(mnum.EQ.8)
THEN 195 ELSEIF(mnum.EQ.101)
THEN 204 ELSEIF(mnum.EQ.102)
THEN 224 IF (rr.LE.prob1)
THEN 226 ELSEIF(rr.LE.(prob1+prob2))
THEN 241 prob3=1.0-prob1-prob2
250 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
251 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
252 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
253 * ,ampiz,ampi,amro,gamro,ama1,gama1
254 * ,amk,amkz,amkst,gamkst
256 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
257 * ,ampiz,ampi,amro,gamro,ama1,gama1
258 * ,amk,amkz,amkst,gamkst
259 COMMON / taubra / gamprt(30),jlist(30),nchan
260 COMMON / taukle / bra1,brk0,brk0b,brks
261 REAL*4 BRA1,BRK0,BRK0B,BRKS
263 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
264 COMMON / taudcd /idffin(9,nmode),mulpik(nmode)
266 CHARACTER NAMES(NMODE)*31
268 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
269 COMMON / taudcd /idffin(9,nmode),mulpik(nmode)
271 CHARACTER NAMES(NMODE)*31
273 CHARACTER OLDNAMES(7)*31
276 $ bxinit =
'(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)' 347 dimension nopik(6,nmode),npik(nmode)
358 DATA nopik / -1,-1, 2, 1, 0, 0, 2, 2, 2,-1, 0, 0,
359 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
360 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
361 3 -3,-1, 3, 0, 0, 0, 4,-1,-4, 0, 0, 0,
362 4 -3, 2, 4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
363 5 -3,-1, 1, 0, 0, 0, -1,-4, 2, 0, 0, 0,
364 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
366 DATA nopik / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
367 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
368 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
369 3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
370 4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
371 5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
372 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
376 7 -3,-4, 0, 0, 0, 0 /
378 7 -3, 4, 0, 0, 0, 0 /
386 IF(i.EQ. 1) gamprt(i) = 1.0000
387 IF(i.EQ. 2) gamprt(i) = 1.0000
388 IF(i.EQ. 3) gamprt(i) = 1.0000
389 IF(i.EQ. 4) gamprt(i) = 1.0000
390 IF(i.EQ. 5) gamprt(i) = 1.0000
391 IF(i.EQ. 6) gamprt(i) = 1.0000
392 IF(i.EQ. 7) gamprt(i) = 1.0000
393 IF(i.EQ. 8) gamprt(i) = 1.0000
394 IF(i.EQ. 9) gamprt(i) = 1.0000
395 IF(i.EQ.10) gamprt(i) = 1.0000
396 IF(i.EQ.11) gamprt(i) = 1.0000
397 IF(i.EQ.12) gamprt(i) = 1.0000
398 IF(i.EQ.13) gamprt(i) = 1.0000
399 IF(i.EQ.14) gamprt(i) = 1.0000
400 IF(i.EQ.15) gamprt(i) = 1.0000
401 IF(i.EQ.16) gamprt(i) = 1.0000
402 IF(i.EQ.17) gamprt(i) = 1.0000
403 IF(i.EQ.18) gamprt(i) = 1.0000
404 IF(i.EQ.19) gamprt(i) = 1.0000
405 IF(i.EQ.20) gamprt(i) = 1.0000
406 IF(i.EQ.21) gamprt(i) = 1.0000
407 IF(i.EQ.22) gamprt(i) = 1.0000
409 IF(i.EQ. 1) gamprt(i) =0.1800
410 IF(i.EQ. 2) gamprt(i) =0.1751
411 IF(i.EQ. 3) gamprt(i) =0.1110
412 IF(i.EQ. 4) gamprt(i) =0.2515
413 IF(i.EQ. 5) gamprt(i) =0.1790
414 IF(i.EQ. 6) gamprt(i) =0.0071
415 IF(i.EQ. 7) gamprt(i) =0.0134
416 IF(i.EQ. 8) gamprt(i) =0.0450
417 IF(i.EQ. 9) gamprt(i) =0.0100
418 IF(i.EQ.10) gamprt(i) =0.0009
419 IF(i.EQ.11) gamprt(i) =0.0004
420 IF(i.EQ.12) gamprt(i) =0.0003
421 IF(i.EQ.13) gamprt(i) =0.0005
422 IF(i.EQ.14) gamprt(i) =0.0015
423 IF(i.EQ.15) gamprt(i) =0.0015
424 IF(i.EQ.16) gamprt(i) =0.0015
425 IF(i.EQ.17) gamprt(i) =0.0005
426 IF(i.EQ.18) gamprt(i) =0.0050
427 IF(i.EQ.19) gamprt(i) =0.0055
428 IF(i.EQ.20) gamprt(i) =0.0017
429 IF(i.EQ.21) gamprt(i) =0.0013
430 IF(i.EQ.22) gamprt(i) =0.0010
431 #elif defined (ALEPH) 432 IF(i.EQ. 1) gamprt(i) = 1.0000
433 IF(i.EQ. 2) gamprt(i) = .9732
434 IF(i.EQ. 3) gamprt(i) = .6217
435 IF(i.EQ. 4) gamprt(i) = 1.4221
436 IF(i.EQ. 5) gamprt(i) = 1.0180
437 IF(i.EQ. 6) gamprt(i) = .0405
438 IF(i.EQ. 7) gamprt(i) = .0781
439 IF(i.EQ. 8) gamprt(i) = .2414
440 IF(i.EQ. 9) gamprt(i) = .0601
441 IF(i.EQ.10) gamprt(i) = .0281
442 IF(i.EQ.11) gamprt(i) = .0045
443 IF(i.EQ.12) gamprt(i) = .0010
444 IF(i.EQ.13) gamprt(i) = .0062
445 IF(i.EQ.14) gamprt(i) = .0096
446 IF(i.EQ.15) gamprt(i) = .0169
447 IF(i.EQ.16) gamprt(i) = .0056
448 IF(i.EQ.17) gamprt(i) = .0045
449 IF(i.EQ.18) gamprt(i) = .0219
450 IF(i.EQ.19) gamprt(i) = .0180
451 IF(i.EQ.20) gamprt(i) = .0096
452 IF(i.EQ.21) gamprt(i) = .0088
453 IF(i.EQ.22) gamprt(i) = .0146
456 IF(i.EQ. 1) oldnames(i)=
' TAU- --> E- ' 457 IF(i.EQ. 2) oldnames(i)=
' TAU- --> MU- ' 458 IF(i.EQ. 3) oldnames(i)=
' TAU- --> PI- ' 459 IF(i.EQ. 4) oldnames(i)=
' TAU- --> PI-, PI0 ' 460 IF(i.EQ. 5) oldnames(i)=
' TAU- --> A1- (two subch) ' 461 IF(i.EQ. 6) oldnames(i)=
' TAU- --> K- ' 462 IF(i.EQ. 7) oldnames(i)=
' TAU- --> K*- (two subch) ' 463 IF(i.EQ. 8) names(i-7)=
' TAU- --> 2PI-, PI0, PI+ ' 464 IF(i.EQ. 9) names(i-7)=
' TAU- --> 3PI0, PI- ' 465 IF(i.EQ.10) names(i-7)=
' TAU- --> 2PI-, PI+, 2PI0 ' 466 IF(i.EQ.11) names(i-7)=
' TAU- --> 3PI-, 2PI+, ' 467 IF(i.EQ.12) names(i-7)=
' TAU- --> 3PI-, 2PI+, PI0 ' 468 IF(i.EQ.13) names(i-7)=
' TAU- --> 2PI-, PI+, 3PI0 ' 469 IF(i.EQ.14) names(i-7)=
' TAU- --> K-, PI-, K+ ' 470 IF(i.EQ.15) names(i-7)=
' TAU- --> K0, PI-, K0B ' 472 IF(i.EQ.16) names(i-7)=
' TAU- --> K- PI0 K0 ' 474 IF(i.EQ.16) names(i-7)=
' TAU- --> K-, K0, PI0 ' 476 IF(i.EQ.17) names(i-7)=
' TAU- --> PI0 PI0 K- ' 477 IF(i.EQ.18) names(i-7)=
' TAU- --> K- PI- PI+ ' 478 IF(i.EQ.19) names(i-7)=
' TAU- --> PI- K0B PI0 ' 479 IF(i.EQ.20) names(i-7)=
' TAU- --> ETA PI- PI0 ' 480 IF(i.EQ.21) names(i-7)=
' TAU- --> PI- PI0 GAM ' 481 IF(i.EQ.22) names(i-7)=
' TAU- --> K- K0 ' 490 idffin(j,i)=nopik(j,i)
517 scabib = sqrt(1.-ccabib**2)
519 gamel = gfermi**2*amtau**5/(192*pi**3)
525 FUNCTION dcdmas(IDENT)
526 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
527 * ,ampiz,ampi,amro,gamro,ama1,gama1
528 * ,amk,amkz,amkst,gamkst
530 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
531 * ,ampiz,ampi,amro,gamro,ama1,gama1
532 * ,amk,amkz,amkst,gamkst
533 IF (ident.EQ. 1)
THEN 535 ELSEIF (ident.EQ.-1)
THEN 537 ELSEIF (ident.EQ. 2)
THEN 539 ELSEIF (ident.EQ.-2)
THEN 541 ELSEIF (ident.EQ. 3)
THEN 543 ELSEIF (ident.EQ.-3)
THEN 545 ELSEIF (ident.EQ. 4)
THEN 547 ELSEIF (ident.EQ.-4)
THEN 549 ELSEIF (ident.EQ. 8)
THEN 551 ELSEIF (ident.EQ.-8)
THEN 553 ELSEIF (ident.EQ. 9)
THEN 555 ELSEIF (ident.EQ.-9)
THEN 558 print *,
'STOP IN APKMAS, WRONG IDENT=',ident
563 FUNCTION lunpik(ID,ISGN)
564 COMMON / taukle / bra1,brk0,brk0b,brks
565 REAL*4 BRA1,BRK0,BRK0B,BRKS
569 IF (ident.EQ. 1)
THEN 571 ELSEIF (ident.EQ.-1)
THEN 573 ELSEIF (ident.EQ. 2)
THEN 575 ELSEIF (ident.EQ.-2)
THEN 577 ELSEIF (ident.EQ. 3)
THEN 579 ELSEIF (ident.EQ.-3)
THEN 582 IF (ident.EQ. 1)
THEN 584 ELSEIF (ident.EQ.-1)
THEN 586 ELSEIF (ident.EQ. 2)
THEN 588 ELSEIF (ident.EQ.-2)
THEN 590 ELSEIF (ident.EQ. 3)
THEN 592 ELSEIF (ident.EQ.-3)
THEN 595 ELSEIF (ident.EQ. 4)
THEN 599 IF (xio(1).GT.brk0)
THEN 604 ELSEIF (ident.EQ.-4)
THEN 608 IF (xio(1).GT.brk0b)
THEN 613 ELSEIF (ident.EQ. 8)
THEN 615 ELSEIF (ident.EQ.-8)
THEN 617 ELSEIF (ident.EQ. 9)
THEN 619 ELSEIF (ident.EQ.-9)
THEN 622 print *,
'STOP IN IPKDEF, WRONG IDENT=',ident
631 SUBROUTINE taurdf(KTO)
635 COMMON / taukle / bra1,brk0,brk0b,brks
636 REAL*4 BRA1,BRK0,BRK0B,BRKS
637 COMMON / taubra / gamprt(30),jlist(30),nchan
657 SUBROUTINE taurdf(KTO)
661 COMMON / taukle / bra1,brk0,brk0b,brks
662 REAL*4 BRA1,BRK0,BRK0B,BRKS
663 COMMON / taubra / gamprt(30),jlist(30),nchan
671 IF(i.EQ. 1) gamprt(i) = .0000
672 IF(i.EQ. 2) gamprt(i) = .0000
673 IF(i.EQ. 3) gamprt(i) = .0000
674 IF(i.EQ. 4) gamprt(i) = .0000
675 IF(i.EQ. 5) gamprt(i) = .0000
676 IF(i.EQ. 6) gamprt(i) = .0000
677 IF(i.EQ. 7) gamprt(i) = .0000
678 IF(i.EQ. 8) gamprt(i) = 1.0000
679 IF(i.EQ. 9) gamprt(i) = 1.0000
680 IF(i.EQ.10) gamprt(i) = 1.0000
681 IF(i.EQ.11) gamprt(i) = 1.0000
682 IF(i.EQ.12) gamprt(i) = 1.0000
683 IF(i.EQ.13) gamprt(i) = 1.0000
684 IF(i.EQ.14) gamprt(i) = 1.0000
685 IF(i.EQ.15) gamprt(i) = 1.0000
686 IF(i.EQ.16) gamprt(i) = 1.0000
687 IF(i.EQ.17) gamprt(i) = 1.0000
688 IF(i.EQ.18) gamprt(i) = 1.0000
689 IF(i.EQ.19) gamprt(i) = 1.0000
714 IF(i.EQ. 1) gamprt(i) = .0000
715 IF(i.EQ. 2) gamprt(i) = .0000
716 IF(i.EQ. 3) gamprt(i) = .0000
717 IF(i.EQ. 4) gamprt(i) = .0000
718 IF(i.EQ. 5) gamprt(i) = .0000
719 IF(i.EQ. 6) gamprt(i) = .0000
720 IF(i.EQ. 7) gamprt(i) = .0000
721 IF(i.EQ. 8) gamprt(i) = 1.0000
722 IF(i.EQ. 9) gamprt(i) = 1.0000
723 IF(i.EQ.10) gamprt(i) = 1.0000
724 IF(i.EQ.11) gamprt(i) = 1.0000
725 IF(i.EQ.12) gamprt(i) = 1.0000
726 IF(i.EQ.13) gamprt(i) = 1.0000
727 IF(i.EQ.14) gamprt(i) = 1.0000
728 IF(i.EQ.15) gamprt(i) = 1.0000
729 IF(i.EQ.16) gamprt(i) = 1.0000
730 IF(i.EQ.17) gamprt(i) = 1.0000
731 IF(i.EQ.18) gamprt(i) = 1.0000
732 IF(i.EQ.19) gamprt(i) = 1.0000
755 SUBROUTINE iniphx(XK00)
760 COMMON / qedprm /alfinv,alfpi,xk0
761 REAL*8 ALFINV,ALFPI,XK0
764 pi8 = 4.d0*datan(1.d0)
766 alfpi = 1d0/(alfinv*pi8)
776 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
777 * ,ampiz,ampi,amro,gamro,ama1,gama1
778 * ,amk,amkz,amkst,gamkst
780 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
781 * ,ampiz,ampi,amro,gamro,ama1,gama1
782 * ,amk,amkz,amkst,gamkst
838 #elif defined (ALEPH) 847 print *,
'INIMAS a1 mass= ',ama1,gama1
857 subroutine bostdq(idir,vv,pp,q)
869 implicit DOUBLE PRECISION (a-h,o-z)
871 DOUBLE PRECISION v(4),p(4),q(4),pp(4),vv(4)
877 amv=(v(4)**2-v(1)**2-v(2)**2-v(3)**2)
879 write(6,*)
'bosstv: warning amv**2=',amv
883 q(4)=( p(1)*v(1)+p(2)*v(2)+p(3)*v(3)+p(4)*v(4))/amv
884 wsp =(q(4)+p(4))/(v(4)+amv)
885 elseif (idir.eq.1)
then 886 q(4)=(-p(1)*v(1)-p(2)*v(2)-p(3)*v(3)+p(4)*v(4))/amv
887 wsp =-(q(4)+p(4))/(v(4)+amv)
889 write(nout,*)
' >>> boostv: wrong value of idir = ',idir
907 IMPLICIT REAL*8(a-h,o-z)
910 IF(x .LT.-1.0)
GO TO 1
911 IF(x .LE. 0.5)
GO TO 2
912 IF(x .EQ. 1.0)
GO TO 3
913 IF(x .LE. 2.0)
GO TO 4
917 z=z-0.5* log(abs(x))**2
923 3 dilogy=1.64493406684822
927 z=1.64493406684822 - log(x)* log(abs(t))
928 5 y=2.66666666666666 *t+0.66666666666666
929 b= 0.00000 00000 00001
930 a=y*b +0.00000 00000 00004
931 b=y*a-b+0.00000 00000 00011
932 a=y*b-a+0.00000 00000 00037
933 b=y*a-b+0.00000 00000 00121
934 a=y*b-a+0.00000 00000 00398
935 b=y*a-b+0.00000 00000 01312
936 a=y*b-a+0.00000 00000 04342
937 b=y*a-b+0.00000 00000 14437
938 a=y*b-a+0.00000 00000 48274
939 b=y*a-b+0.00000 00001 62421
940 a=y*b-a+0.00000 00005 50291
941 b=y*a-b+0.00000 00018 79117
942 a=y*b-a+0.00000 00064 74338
943 b=y*a-b+0.00000 00225 36705
944 a=y*b-a+0.00000 00793 87055
945 b=y*a-b+0.00000 02835 75385
946 a=y*b-a+0.00000 10299 04264
947 b=y*a-b+0.00000 38163 29463
948 a=y*b-a+0.00001 44963 00557
949 b=y*a-b+0.00005 68178 22718
950 a=y*b-a+0.00023 20021 96094
951 b=y*a-b+0.00100 16274 96164
952 a=y*b-a+0.00468 63619 59447
953 b=y*a-b+0.02487 93229 24228
954 a=y*b-a+0.16607 30329 27855
955 a=y*a-b+1.93506 43008 6996