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(4)
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