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)
97 SUBROUTINE choice(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
98 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
99 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
100 * ,ampiz,ampi,amro,gamro,ama1,gama1
101 * ,amk,amkz,amkst,gamkst
103 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
104 * ,ampiz,ampi,amro,gamro,ama1,gama1
105 * ,amk,amkz,amkst,gamkst
121 ELSEIF(mnum.EQ.1)
THEN
130 ELSEIF(mnum.EQ.2)
THEN
139 ELSEIF(mnum.EQ.3)
THEN
148 ELSEIF(mnum.EQ.4)
THEN
157 ELSEIF(mnum.EQ.5)
THEN
166 ELSEIF(mnum.EQ.6)
THEN
175 ELSEIF(mnum.EQ.7)
THEN
184 ELSEIF(mnum.EQ.8)
THEN
193 ELSEIF(mnum.EQ.9)
THEN
202 ELSEIF(mnum.EQ.101)
THEN
211 ELSEIF(mnum.EQ.102)
THEN
220 ELSEIF(mnum.GE.103.AND.mnum.LE.112)
THEN
242 IF (rr.LE.prob1)
THEN
244 ELSEIF(rr.LE.(prob1+prob2))
THEN
259 prob3=1.0-prob1-prob2
268 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
269 real*4 gfermi,gv,ga,ccabib,scabib,gamel
270 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
271 * ,ampiz,ampi,amro,gamro,ama1,gama1
272 * ,amk,amkz,amkst,gamkst
274 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
275 * ,ampiz,ampi,amro,gamro,ama1,gama1
276 * ,amk,amkz,amkst,gamkst
277 COMMON / taubra / gamprt(500),jlist(500),nchan
278 COMMON / taukle / bra1,brk0,brk0b,brks
279 real*4 bra1,brk0,brk0b,brks
281 parameter(nmode=86,nm1=0,nm2=11,nm3=19,nm4=22,nm5=21,nm6=13)
282 COMMON / taudcd /idffin(9,nmode),mulpik(nmode)
284 CHARACTER NAMES(NMODE)*31
286 CHARACTER OLDNAMES(7)*31
289 $ bxinit =
'(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
313 dimension nopik(9,nmode),npik(nmode)
361 DATA nopik / -1,-1, 1, 2, 0, 0,3*0, 2, 2, 2,-1, 0, 0,3*0,
362 a 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
363 b 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
364 c 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
365 d 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
366 e 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
367 a 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
368 b 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
369 c 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
370 d 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
371 e 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0,
372 1 -1,-1, 1, 2, 2, 0,3*0,
373 a -1,-1, 1, 2, 2, 0,3*0, 2, 2, 2, 2, 2, 0,3*0,
374 a 1,-1,-1, 2, 2, 0,3*0, -1, 2, 2, 2, 2, 0,3*0,
375 a -1, 1, 1,-1,-1, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
376 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
377 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
378 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
379 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
380 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
381 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
382 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0,
383 x -1,-1,-1, 1, 1, 0,3*0,
384 2 -1,-1,-1, 1, 1, 2,3*0, -1,-1, 1, 2, 2, 2,3*0,
385 a -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
386 b -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
387 c -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
388 d -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
389 e -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0,
390 3 -3,-1, 3, 0, 0, 0,3*0, -4,-1, 4, 0, 0, 0,3*0,
391 4 -3, 2,-4, 0, 0, 0,3*0, 2, 2,-3, 0, 0, 0,3*0,
392 5 -3,-1, 1, 0, 0, 0,3*0, -1, 4, 2, 0, 0, 0,3*0,
393 6 9,-1, 2, 0, 0, 0,3*0, -1, 2, 8, 0, 0, 0,3*0,
397 7 2, 2,-1, 0, 0, 0,3*0,
398 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
399 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
400 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
401 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
402 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0,
404 8 -3,-4, 0, 0, 0, 0,3*0,
405 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0,
406 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0,
407 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0,
408 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0,
409 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0 /
418 IF(i.EQ. 1) gamprt(i) =0.1800
419 IF(i.EQ. 2) gamprt(i) =0.1751
420 IF(i.EQ. 3) gamprt(i) =0.1110
421 IF(i.EQ. 4) gamprt(i) =0.2515
422 IF(i.EQ. 5) gamprt(i) =0.1790 /2
423 IF(i.EQ. 6) gamprt(i) =0.0071
424 IF(i.EQ. 7) gamprt(i) =0.0134
425 IF(i.EQ. 8) gamprt(i) =0.0450
426 IF(i.EQ. 9) gamprt(i) =0.0100
428 IF(i.EQ.30) gamprt(i) =0.0009
429 IF(i.EQ.33) gamprt(i) =0.004
430 IF(i.EQ.34) gamprt(i) =0.002
431 IF(i.EQ.35) gamprt(i) =0.001
433 IF(i.EQ.51) gamprt(i) =0.0004
434 IF(i.EQ.52) gamprt(i) =0.0003
435 IF(i.EQ.53) gamprt(i) =0.0005
437 IF(i.EQ.64) gamprt(i) =0.0015
438 IF(i.EQ.65) gamprt(i) =0.0015
439 IF(i.EQ.66) gamprt(i) =0.0015
440 IF(i.EQ.67) gamprt(i) =0.0005
441 IF(i.EQ.68) gamprt(i) =0.0050
442 IF(i.EQ.69) gamprt(i) =0.0055
443 IF(i.EQ.70) gamprt(i) =0.0017
444 IF(i.EQ.71) gamprt(i) =0.0013
445 IF(i.EQ.72) gamprt(i) =0.1790 /2
447 IF(i.EQ.83) gamprt(i) =0.0010
449 IF(i.EQ. 1) oldnames(i)=
' TAU- --> E- '
450 IF(i.EQ. 2) oldnames(i)=
' TAU- --> MU- '
451 IF(i.EQ. 3) oldnames(i)=
' TAU- --> PI- '
452 IF(i.EQ. 4) oldnames(i)=
' TAU- --> PI-, PI0 '
453 IF(i.EQ. 5) oldnames(i)=
' TAU- --> PI-, PI-, PI+ '
454 IF(i.EQ. 6) oldnames(i)=
' TAU- --> K- '
455 IF(i.EQ. 7) oldnames(i)=
' TAU- --> K*- (two subch) '
456 IF(i.EQ. 8) names(i-7)=
' TAU- --> 2PI-, PI0, PI+ '
457 IF(i.EQ. 9) names(i-7)=
' TAU- --> 3PI0, PI- '
459 IF(i.EQ.10) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
460 IF(i.EQ.11) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
461 IF(i.EQ.12) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
462 IF(i.EQ.13) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
463 IF(i.EQ.14) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
464 IF(i.EQ.15) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
465 IF(i.EQ.16) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
466 IF(i.EQ.17) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
467 IF(i.EQ.18) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
468 IF(i.EQ.19) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
469 IF(i.EQ.20) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
470 IF(i.EQ.21) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
471 IF(i.EQ.22) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
472 IF(i.EQ.23) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
473 IF(i.EQ.24) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
474 IF(i.EQ.25) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
475 IF(i.EQ.26) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
476 IF(i.EQ.27) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
477 IF(i.EQ.28) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
478 IF(i.EQ.29) names(i-7)=
' TAU- --> xxxxxxx4xxxxxxxx '
481 IF(i.EQ.30) names(i-7)=
' TAU- --> 2PI-, PI+, 2PI0 old'
482 IF(i.EQ.31) names(i-7)=
' TAU- --> a1 --> rho omega '
483 IF(i.EQ.32) names(i-7)=
' TAU- --> benchmark curr '
484 IF(i.EQ.33) names(i-7)=
' TAU- --> 2PI0, 2PI-, PI+ '
485 IF(i.EQ.34) names(i-7)=
' TAU- --> PI- 4PI0 '
486 IF(i.EQ.35) names(i-7)=
' TAU- --> 3PI- 2PI+ '
487 IF(i.EQ.36) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
488 IF(i.EQ.37) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
489 IF(i.EQ.38) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
490 IF(i.EQ.39) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
491 IF(i.EQ.40) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
493 IF(i.EQ.41) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
494 IF(i.EQ.42) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
495 IF(i.EQ.43) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
496 IF(i.EQ.44) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
497 IF(i.EQ.45) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
498 IF(i.EQ.46) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
499 IF(i.EQ.47) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
500 IF(i.EQ.48) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
501 IF(i.EQ.49) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
502 IF(i.EQ.50) names(i-7)=
' TAU- --> xxxxxxxxx5xxxxxx '
504 IF(i.EQ.51) names(i-7)=
' TAU- --> 3PI-, 2PI+, '
505 IF(i.EQ.52) names(i-7)=
' TAU- --> 3PI-, 2PI+, PI0 '
506 IF(i.EQ.53) names(i-7)=
' TAU- --> 2PI-, PI+, 3PI0 '
507 IF(i.EQ.54) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
508 IF(i.EQ.55) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
509 IF(i.EQ.56) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
510 IF(i.EQ.57) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
511 IF(i.EQ.58) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
512 IF(i.EQ.59) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
513 IF(i.EQ.60) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
514 IF(i.EQ.61) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
515 IF(i.EQ.62) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
516 IF(i.EQ.63) names(i-7)=
' TAU- --> xxxxxxxxxnxxxxxx '
518 IF(i.EQ.64) names(i-7)=
' TAU- --> K-, PI-, K+ '
519 IF(i.EQ.65) names(i-7)=
' TAU- --> K0, PI-, K0B '
521 IF(i.EQ.66) names(i-7)=
' TAU- --> K-, K0, PI0 '
523 IF(i.EQ.67) names(i-7)=
' TAU- --> PI0 PI0 K- '
524 IF(i.EQ.68) names(i-7)=
' TAU- --> K- PI- PI+ '
525 IF(i.EQ.69) names(i-7)=
' TAU- --> PI- K0B PI0 '
526 IF(i.EQ.70) names(i-7)=
' TAU- --> ETA PI- PI0 '
527 IF(i.EQ.71) names(i-7)=
' TAU- --> PI- PI0 GAM '
528 IF(i.EQ.72) names(i-7)=
' TAU- --> PI- PI0 PI0 '
529 IF(i.EQ.73) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
530 IF(i.EQ.74) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
531 IF(i.EQ.75) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
532 IF(i.EQ.76) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
533 IF(i.EQ.77) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
534 IF(i.EQ.78) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
535 IF(i.EQ.79) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
536 IF(i.EQ.80) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
537 IF(i.EQ.81) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
538 IF(i.EQ.82) names(i-7)=
' TAU- --> xxxxxxxxx3xxxxxx '
541 IF(i.EQ.83) names(i-7)=
' TAU- --> K- K0 '
542 IF(i.EQ.84) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
543 IF(i.EQ.85) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
544 IF(i.EQ.86) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
545 IF(i.EQ.87) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
546 IF(i.EQ.88) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
547 IF(i.EQ.89) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
548 IF(i.EQ.90) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
549 IF(i.EQ.91) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
550 IF(i.EQ.92) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
551 IF(i.EQ.93) names(i-7)=
' TAU- --> xxxxxxxxx2xxxxxx '
561 idffin(j,i)=nopik(j,i)
565 gamprt(i) = 1d0/nchan
567 gamprt(31)=gamprt(31)*0.001
568 gamprt(32)=gamprt(32)*0.001
570 gamprt(36+k)=gamprt(36+k)*0.001
571 gamprt(30-k)=gamprt(30-k)*0.001
572 gamprt(30+10+k)=gamprt(30+10+k)*0.001
573 gamprt(30-10-k)=gamprt(30-10-k)*0.001
575 gamprt(53+k)=gamprt(53+k)*0.001
576 gamprt(72+k)=gamprt(72+k)*0.001
577 gamprt(83+k)=gamprt(83+k)*0.001
579 gamprt(72)=gamprt(72)/2
580 gamprt(5)=gamprt(5)/2
606 scabib = sqrt(1.-ccabib**2)
608 gamel = gfermi**2*amtau**5/(192*pi**3)
614 FUNCTION dcdmas(IDENT)
615 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
616 * ,ampiz,ampi,amro,gamro,ama1,gama1
617 * ,amk,amkz,amkst,gamkst
619 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
620 * ,ampiz,ampi,amro,gamro,ama1,gama1
621 * ,amk,amkz,amkst,gamkst
622 IF (ident.EQ. 1)
THEN
624 ELSEIF (ident.EQ.-1)
THEN
626 ELSEIF (ident.EQ. 2)
THEN
628 ELSEIF (ident.EQ.-2)
THEN
630 ELSEIF (ident.EQ. 3)
THEN
632 ELSEIF (ident.EQ.-3)
THEN
634 ELSEIF (ident.EQ. 4)
THEN
636 ELSEIF (ident.EQ.-4)
THEN
638 ELSEIF (ident.EQ. 8)
THEN
640 ELSEIF (ident.EQ.-8)
THEN
642 ELSEIF (ident.EQ. 9)
THEN
644 ELSEIF (ident.EQ.-9)
THEN
647 print *,
'STOP IN APKMAS, WRONG IDENT=',ident
652 FUNCTION lunpik(ID,ISGN)
653 COMMON / taukle / bra1,brk0,brk0b,brks
654 real*4 bra1,brk0,brk0b,brks
658 IF (ident.EQ. 1)
THEN
660 ELSEIF (ident.EQ.-1)
THEN
662 ELSEIF (ident.EQ. 2)
THEN
664 ELSEIF (ident.EQ.-2)
THEN
666 ELSEIF (ident.EQ. 3)
THEN
668 ELSEIF (ident.EQ.-3)
THEN
671 ELSEIF (ident.EQ. 4)
THEN
675 IF (xio(1).GT.brk0)
THEN
680 ELSEIF (ident.EQ.-4)
THEN
684 IF (xio(1).GT.brk0b)
THEN
689 ELSEIF (ident.EQ. 8)
THEN
691 ELSEIF (ident.EQ.-8)
THEN
693 ELSEIF (ident.EQ. 9)
THEN
695 ELSEIF (ident.EQ.-9)
THEN
698 print *,
'STOP IN IPKDEF, WRONG IDENT=',ident
707 SUBROUTINE taurdf(KTO)
711 COMMON / taukle / bra1,brk0,brk0b,brks
712 real*4 bra1,brk0,brk0b,brks
713 COMMON / taubra / gamprt(500),jlist(500),nchan
733 SUBROUTINE iniphx(XK00)
738 COMMON / qedprm /alfinv,alfpi,xk0
739 real*8 alfinv,alfpi,xk0
742 pi8 = 4.d0*datan(1.d0)
744 alfpi = 1d0/(alfinv*pi8)
754 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
755 * ,ampiz,ampi,amro,gamro,ama1,gama1
756 * ,amk,amkz,amkst,gamkst
758 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
759 * ,ampiz,ampi,amro,gamro,ama1,gama1
760 * ,amk,amkz,amkst,gamkst
808 subroutine bostdq(idir,vv,pp,q)
820 implicit DOUBLE PRECISION (a-h,o-z)
822 DOUBLE PRECISION v(4),p(4),q(4),pp(4),vv(4)
828 amv=(v(4)**2-v(1)**2-v(2)**2-v(3)**2)
830 write(6,*)
'bosstv: warning amv**2=',amv
834 q(4)=( p(1)*v(1)+p(2)*v(2)+p(3)*v(3)+p(4)*v(4))/amv
835 wsp =(q(4)+p(4))/(v(4)+amv)
836 elseif (idir.eq.1)
then
837 q(4)=(-p(1)*v(1)-p(2)*v(2)-p(3)*v(3)+p(4)*v(4))/amv
838 wsp =-(q(4)+p(4))/(v(4)+amv)
840 write(nout,*)
' >>> boostv: wrong value of idir = ',idir