2 SUBROUTINE choice(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
3 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
4 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
5 * ,ampiz,ampi,amro,gamro,ama1,gama1
6 * ,amk,amkz,amkst,gamkst
8 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
9 * ,ampiz,ampi,amro,gamro,ama1,gama1
10 * ,amk,amkz,amkst,gamkst
26 ELSEIF(mnum.EQ.1)
THEN
35 ELSEIF(mnum.EQ.2)
THEN
44 ELSEIF(mnum.EQ.3)
THEN
53 ELSEIF(mnum.EQ.4)
THEN
62 ELSEIF(mnum.EQ.5)
THEN
71 ELSEIF(mnum.EQ.6)
THEN
80 ELSEIF(mnum.EQ.7)
THEN
89 ELSEIF(mnum.EQ.8)
THEN
98 ELSEIF(mnum.EQ.101)
THEN
107 ELSEIF(mnum.EQ.102)
THEN
127 IF (rr.LE.prob1)
THEN
129 ELSEIF(rr.LE.(prob1+prob2))
THEN
144 prob3=1.0-prob1-prob2
153 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
154 real*4 gfermi,gv,ga,ccabib,scabib,gamel
155 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
156 * ,ampiz,ampi,amro,gamro,ama1,gama1
157 * ,amk,amkz,amkst,gamkst
159 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
160 * ,ampiz,ampi,amro,gamro,ama1,gama1
161 * ,amk,amkz,amkst,gamkst
162 COMMON / taubra / gamprt(30),jlist(30),nchan
163 COMMON / taukle / bra1,brk0,brk0b,brks
164 real*4 bra1,brk0,brk0b,brks
171 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
172 COMMON / taudcd /idffin(9,nmode),mulpik(nmode)
174 CHARACTER NAMES(NMODE)*31
176 CHARACTER OLDNAMES(7)*31
179 $ bxinit =
'(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
201 dimension nopik(6,nmode),npik(nmode)
211 DATA nopik / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
212 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
213 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
214 3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
215 4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
216 5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
217 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
219 7 -3,-4, 0, 0, 0, 0 /
225 IF(i.EQ. 1) gamprt(i) =0.1800
226 IF(i.EQ. 2) gamprt(i) =0.1751
227 IF(i.EQ. 3) gamprt(i) =0.1110
228 IF(i.EQ. 4) gamprt(i) =0.2515
229 IF(i.EQ. 5) gamprt(i) =0.1790
230 IF(i.EQ. 6) gamprt(i) =0.0071
231 IF(i.EQ. 7) gamprt(i) =0.0134
232 IF(i.EQ. 8) gamprt(i) =0.0450
233 IF(i.EQ. 9) gamprt(i) =0.0100
234 IF(i.EQ.10) gamprt(i) =0.0009
235 IF(i.EQ.11) gamprt(i) =0.0004
236 IF(i.EQ.12) gamprt(i) =0.0003
237 IF(i.EQ.13) gamprt(i) =0.0005
238 IF(i.EQ.14) gamprt(i) =0.0015
239 IF(i.EQ.15) gamprt(i) =0.0015
240 IF(i.EQ.16) gamprt(i) =0.0015
241 IF(i.EQ.17) gamprt(i) =0.0005
242 IF(i.EQ.18) gamprt(i) =0.0050
243 IF(i.EQ.19) gamprt(i) =0.0055
244 IF(i.EQ.20) gamprt(i) =0.0017
245 IF(i.EQ.21) gamprt(i) =0.0013
246 IF(i.EQ.22) gamprt(i) =0.0010
247 IF(i.EQ. 1) oldnames(i)=
' TAU- --> E- '
248 IF(i.EQ. 2) oldnames(i)=
' TAU- --> MU- '
249 IF(i.EQ. 3) oldnames(i)=
' TAU- --> PI- '
250 IF(i.EQ. 4) oldnames(i)=
' TAU- --> PI-, PI0 '
251 IF(i.EQ. 5) oldnames(i)=
' TAU- --> A1- (two subch) '
252 IF(i.EQ. 6) oldnames(i)=
' TAU- --> K- '
253 IF(i.EQ. 7) oldnames(i)=
' TAU- --> K*- (two subch) '
254 IF(i.EQ. 8) names(i-7)=
' TAU- --> 2PI-, PI0, PI+ '
255 IF(i.EQ. 9) names(i-7)=
' TAU- --> 3PI0, PI- '
256 IF(i.EQ.10) names(i-7)=
' TAU- --> 2PI-, PI+, 2PI0 '
257 IF(i.EQ.11) names(i-7)=
' TAU- --> 3PI-, 2PI+, '
258 IF(i.EQ.12) names(i-7)=
' TAU- --> 3PI-, 2PI+, PI0 '
259 IF(i.EQ.13) names(i-7)=
' TAU- --> 2PI-, PI+, 3PI0 '
260 IF(i.EQ.14) names(i-7)=
' TAU- --> K-, PI-, K+ '
261 IF(i.EQ.15) names(i-7)=
' TAU- --> K0, PI-, K0B '
262 IF(i.EQ.16) names(i-7)=
' TAU- --> K-, K0, PI0 '
263 IF(i.EQ.17) names(i-7)=
' TAU- --> PI0 PI0 K- '
264 IF(i.EQ.18) names(i-7)=
' TAU- --> K- PI- PI+ '
265 IF(i.EQ.19) names(i-7)=
' TAU- --> PI- K0B PI0 '
266 IF(i.EQ.20) names(i-7)=
' TAU- --> ETA PI- PI0 '
267 IF(i.EQ.21) names(i-7)=
' TAU- --> PI- PI0 GAM '
268 IF(i.EQ.22) names(i-7)=
' TAU- --> K- K0 '
277 idffin(j,i)=nopik(j,i)
304 scabib = sqrt(1.-ccabib**2)
306 gamel = gfermi**2*amtau**5/(192*pi**3)
312 FUNCTION dcdmas(IDENT)
313 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
314 * ,ampiz,ampi,amro,gamro,ama1,gama1
315 * ,amk,amkz,amkst,gamkst
317 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
318 * ,ampiz,ampi,amro,gamro,ama1,gama1
319 * ,amk,amkz,amkst,gamkst
320 IF (ident.EQ. 1)
THEN
322 ELSEIF (ident.EQ.-1)
THEN
324 ELSEIF (ident.EQ. 2)
THEN
326 ELSEIF (ident.EQ.-2)
THEN
328 ELSEIF (ident.EQ. 3)
THEN
330 ELSEIF (ident.EQ.-3)
THEN
332 ELSEIF (ident.EQ. 4)
THEN
334 ELSEIF (ident.EQ.-4)
THEN
336 ELSEIF (ident.EQ. 8)
THEN
338 ELSEIF (ident.EQ.-8)
THEN
340 ELSEIF (ident.EQ. 9)
THEN
342 ELSEIF (ident.EQ.-9)
THEN
345 print *,
'STOP IN APKMAS, WRONG IDENT=',ident
350 FUNCTION lunpik(ID,ISGN)
351 COMMON / taukle / bra1,brk0,brk0b,brks
352 real*4 bra1,brk0,brk0b,brks
355 IF (ident.EQ. 1)
THEN
357 ELSEIF (ident.EQ.-1)
THEN
359 ELSEIF (ident.EQ. 2)
THEN
361 ELSEIF (ident.EQ.-2)
THEN
363 ELSEIF (ident.EQ. 3)
THEN
365 ELSEIF (ident.EQ.-3)
THEN
367 ELSEIF (ident.EQ. 4)
THEN
371 IF (xio(1).GT.brk0)
THEN
376 ELSEIF (ident.EQ.-4)
THEN
380 IF (xio(1).GT.brk0b)
THEN
385 ELSEIF (ident.EQ. 8)
THEN
387 ELSEIF (ident.EQ.-8)
THEN
389 ELSEIF (ident.EQ. 9)
THEN
391 ELSEIF (ident.EQ.-9)
THEN
394 print *,
'STOP IN IPKDEF, WRONG IDENT=',ident
402 SUBROUTINE taurdf(KTO)
406 COMMON / taukle / bra1,brk0,brk0b,brks
407 real*4 bra1,brk0,brk0b,brks
408 COMMON / taubra / gamprt(30),jlist(30),nchan
432 SUBROUTINE iniphy(XK00)
437 COMMON / qedprm /alfinv,alfpi,xk0
438 real*8 alfinv,alfpi,xk0
441 pi8 = 4.d0*datan(1.d0)
443 alfpi = 1d0/(alfinv*pi8)
453 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
454 * ,ampiz,ampi,amro,gamro,ama1,gama1
455 * ,amk,amkz,amkst,gamkst
457 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
458 * ,ampiz,ampi,amro,gamro,ama1,gama1
459 * ,amk,amkz,amkst,gamkst
505 SUBROUTINE angulu(PD1,PD2,Q1,Q2,COSTHE)
506 real*8 pd1(4),pd2(4),q1(4),q2(4),costhe,p(4),qq(4),qt(4)
512 xm1=abs(pd1(4)**2-pd1(3)**2-pd1(2)**2-pd1(1)**2)
513 xm2=abs(pd2(4)**2-pd2(3)**2-pd2(2)**2-pd2(1)**2)
531 xmqq=sqrt(qq(4)**2-qq(3)**2-qq(2)**2-qq(1)**2)
533 qtxqq=qt(4)*qq(4)-qt(3)*qq(3)-qt(2)*qq(2)-qt(1)*qq(1)
535 qt(k)=qt(k)-qq(k)*qtxqq/xmqq**2
538 pxqq=p(4)*qq(4)-p(3)*qq(3)-p(2)*qq(2)-p(1)*qq(1)
540 p(k)=p(k)-qq(k)*pxqq/xmqq**2
543 pxp =sqrt(p(1)**2+p(2)**2+p(3)**2-p(4)**2)
544 qtxqt=sqrt(qt(3)**2+qt(2)**2+qt(1)**2-qt(4)**2)
545 pxqt =p(3)*qt(3)+p(2)*qt(2)+p(1)*qt(1)-p(4)*qt(4)
546 costhe=pxqt/pxp/qtxqt
550 FUNCTION plzap0(IDE,IDF,SVAR,COSTH0)
553 real*8 plzap0,svar,costhe,costh0,t_born
560 CALL initwk(ide,idf,svar)
562 CALL initwk(-ide,-idf,svar)
564 plzap0=t_born(0,svar,costhe,1d0,1d0)
565 $ /(t_born(0,svar,costhe,1d0,1d0)+t_born(0,svar,costhe,-1d0,-1d0))
581 FUNCTION t_born(MODE,SVAR,COSTHE,TA,TB)
593 IMPLICIT REAL*8(a-h,o-z)
594 COMMON / t_beampm / ene ,amin,amfin,ide,idf
595 real*8 ene ,amin,amfin
596 COMMON / t_gauspm /ss,poln,t3e,qe,t3f,qf
597 & ,xupgi ,xupzi ,xupgf ,xupzf
598 & ,ndiag0,ndiaga,keya,keyz
599 & ,itce,jtce,itcf,jtcf,kolor
600 real*8 ss,poln,t3e,qe,t3f,qf
601 & ,xupgi(2),xupzi(2),xupgf(2),xupzf(2)
604 COMMON / t_gswprm /swsq,amw,amz,amh,amtop,gammz
605 real*8 swsq,amw,amz,amh,amtop,gammz
611 COMPLEX*16 ABORN(2,2),APHOT(2,2),AZETT(2,2)
612 COMPLEX*16 XUPZFP(2),XUPZIP(2)
613 COMPLEX*16 ABORNM(2,2),APHOTM(2,2),AZETTM(2,2)
614 COMPLEX*16 PROPA,PROPZ
618 DATA xi/(0.d0,1.d0)/,xr/(1.d0,0.d0)/
621 DATA svar0,cost0 /-5.d0,-6.d0/
622 DATA pi /3.141592653589793238462643d0/
623 DATA seps1,seps2 /0d0,0d0/
626 IF ( mode.NE.mode0.OR.svar.NE.svar0.OR.costhe.NE.cost0
627 $ .OR.ide0.NE.ide)
THEN
635 sinthe=sqrt(1.d0-costhe**2)
636 beta=sqrt(max(0d0,1d0-4d0*amfin**2/svar))
639 xupzfp(1)=0.5d0*(xupzf(1)+xupzf(2))+0.5d0*beta*(xupzf(1)-xupzf(2
640 xupzfp(2)=0.5d0*(xupzf(1)+xupzf(2))-0.5d0*beta*(xupzf(1)-xupzf(2
641 xupzip(1)=0.5d0*(xupzi(1)+xupzi(2))+0.5d0*(xupzi(1)-xupzi(2))
642 xupzip(2)=0.5d0*(xupzi(1)+xupzi(2))-0.5d0*(xupzi(1)-xupzi(2))
644 xupf =0.5d0*(xupzf(1)+xupzf(2))
645 xupi =0.5d0*(xupzi(1)+xupzi(2))
649 propa =propa *(137.03604d0/128.86674175d0)
652 propz =1d0/dcmplx(svar-amz**2,amz*gammz)
656 zetvpi = gfermi *amz**2 *alphainv /(dsqrt(2.d0)*8.d0*pi)
657 $ *(swsq*(1d0-swsq)) *16d0
661 IF (keygsw.EQ.0) propz=0.d0
664 regula= (3-2*i)*(3-2*j) + costhe
665 regulm=-(3-2*i)*(3-2*j) * sinthe *2.d0*amfin/sqrt(svar)
666 aphot(i,j)=propa*(xupgi(i)*xupgf(j)*regula)
667 azett(i,j)=propz*(xupzip(i)*xupzfp(j)+xthing)*regula
668 aborn(i,j)=aphot(i,j)+azett(i,j)
669 aphotm(i,j)=propa*dcmplx(0d0,1d0)*xupgi(i)*xupgf(j)*regulm
670 azettm(i,j)=propz*dcmplx(0d0,1d0)*(xupzip(i)*xupf+xthing)*regulm
671 abornm(i,j)=aphotm(i,j)+azettm(i,j)
686 factor=kolor*(1d0+helic*polar1)*(1d0-helic*polar2)/4d0
687 factom=factor*(1+helit*ta)*(1-helit*tb)
688 factor=factor*(1+helit*ta)*(1+helit*tb)
690 born=born+cdabs(aborn(i,j))**2*factor
693 born=born+cdabs(abornm(i,j))**2*factom
699 IF(funt.LT.0.d0) funt=born
702 IF (svar.GT.4d0*amfin**2)
THEN
704 thresh=sqrt(1-4d0*amfin**2/svar)
706 t_born= funt*svar**2*thresh
713 SUBROUTINE initwk(IDEX,IDFX,SVAR)
715 IMPLICIT REAL*8 (a-h,o-z)
716 COMMON / t_beampm / ene ,amin,amfin,ide,idf
717 real*8 ene ,amin,amfin
718 COMMON / t_gauspm /ss,poln,t3e,qe,t3f,qf
719 & ,xupgi ,xupzi ,xupgf ,xupzf
720 & ,ndiag0,ndiaga,keya,keyz
721 & ,itce,jtce,itcf,jtcf,kolor
722 real*8 ss,poln,t3e,qe,t3f,qf
723 & ,xupgi(2),xupzi(2),xupgf(2),xupzf(2)
724 COMMON / t_gswprm /swsq,amw,amz,amh,amtop,gammz
725 real*8 swsq,amw,amz,amh,amtop,gammz
737 IF (idfx.EQ. 15)
then
740 ELSEIF (idfx.EQ.-15)
then
744 WRITE(*,*)
'INITWK: WRONG IDFX'
748 IF (idex.EQ. 11)
then
751 ELSEIF (idex.EQ.-11)
then
754 ELSEIF (idex.EQ. 13)
then
757 ELSEIF (idex.EQ.-13)
then
760 ELSEIF (idex.EQ. 1)
then
763 ELSEIF (idex.EQ.- 1)
then
766 ELSEIF (idex.EQ. 2)
then
769 ELSEIF (idex.EQ.- 2)
then
772 ELSEIF (idex.EQ. 3)
then
775 ELSEIF (idex.EQ.- 3)
then
778 ELSEIF (idex.EQ. 4)
then
781 ELSEIF (idex.EQ.- 4)
then
784 ELSEIF (idex.EQ. 5)
then
787 ELSEIF (idex.EQ.- 5)
then
790 ELSEIF (idex.EQ. 12)
then
793 ELSEIF (idex.EQ.- 12)
then
796 ELSEIF (idex.EQ. 14)
then
799 ELSEIF (idex.EQ.- 14)
then
802 ELSEIF (idex.EQ. 16)
then
805 ELSEIF (idex.EQ.- 16)
then
810 WRITE(*,*)
'INITWK: WRONG IDEX'
824 CALL t_givizo( ide, 1,aizor,qe,kdumm)
825 CALL t_givizo( ide,-1,aizol,qe,kdumm)
829 xupzi(1)=(aizor-qe*swsq)/sqrt(swsq*(1-swsq))
830 xupzi(2)=(aizol-qe*swsq)/sqrt(swsq*(1-swsq))
831 CALL t_givizo( idf, 1,aizor,qf,kolor)
832 CALL t_givizo( idf,-1,aizol,qf,kolor)
836 xupzf(1)=(aizor-qf*swsq)/sqrt(swsq*(1-swsq))
837 xupzf(2)=(aizol-qf*swsq)/sqrt(swsq*(1-swsq))
848 SUBROUTINE t_givizo(IDFERM,IHELIC,SIZO3,CHARGE,KOLOR)
860 IMPLICIT REAL*8(a-h,o-z)
862 IF(idferm.EQ.0.OR.iabs(idferm).GT.4)
GOTO 901
863 IF(iabs(ihelic).NE.1)
GOTO 901
867 lepqua=int(idtype*0.4999999d0)
868 iupdow=idtype-2*lepqua-1
869 charge =(-iupdow+2d0/3d0*lepqua)*ic
870 sizo3 =0.25d0*(ic-ih)*(1-2*iupdow)
875 901 print *,
' STOP IN GIVIZO: WRONG PARAMS.'
878 SUBROUTINE phyfix(NSTOP,NSTART)
879 common/lujets/n,k(4000,5),p(4000,5),v(4000,5)
885 IF(k(i,1).NE.21)
THEN
895 SUBROUTINE taupi0(PI0,K)
910 COMMON /taupos/ np1,np2
912 REAL PHOT1(4),PHOT2(4)
913 real*8 r,x(4),y(4),pi0(4)
919 r=sqrt(pi0(4)**2-pi0(3)**2-pi0(2)**2-pi0(1)**2)/2d0
928 CALL bostdq(-1,pi0,x,x)
929 CALL bostdq(-1,pi0,y,y)
935 CALL filhep(0,1,22,k,k,0,0,phot1,0.0,.true.)
936 CALL filhep(0,1,22,k,k,0,0,phot2,0.0,.true.)
940 SUBROUTINE taueta(PETA,K)
948 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
949 * ,ampiz,ampi,amro,gamro,ama1,gama1
950 * ,amk,amkz,amkst,gamkst
952 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
953 * ,ampiz,ampi,amro,gamro,ama1,gama1
954 * ,amk,amkz,amkst,gamkst
958 REAL RRR(1),BRSUM(3), RR(2)
959 REAL PHOT1(4),PHOT2(4),PHOT3(4)
960 real*8 x(4), y(4), z(4)
962 real*8 r,ru,peta(4),xm1,xm2,xm3,xlam
965 xlam(a,b,c)=sqrt(abs((a-b-c)**2-4.0*b*c))
972 brsum(2)=brsum(1)+0.319
973 brsum(3)=brsum(2)+0.237
976 IF (rrr(1).LT.brsum(1))
THEN
978 r=sqrt(peta(4)**2-peta(3)**2-peta(2)**2-peta(1)**2)/2d0
987 CALL bostdq(-1,peta,x,x)
988 CALL bostdq(-1,peta,y,y)
994 CALL filhep(0,1,22,k,k,0,0,phot1,0.0,.true.)
995 CALL filhep(0,1,22,k,k,0,0,phot2,0.0,.true.)
997 IF(rrr(1).LT.brsum(2))
THEN
1004 ELSEIF(rrr(1).LT.brsum(3))
THEN
1021 r=sqrt(peta(4)**2-peta(3)**2-peta(2)**2-peta(1)**2)
1024 am2=sqrt(amin**2+rr(1)*(amax**2-amin**2))
1026 wt=xlam(1d0*r**2,1d0*am2**2,1d0*xm3**2)
1027 & *xlam(1d0*am2**2,1d0*xm1**2,1d0*xm2**2)
1029 IF (rr(2).GT.wt)
GOTO 7
1031 ru=xlam(1d0*am2**2,1d0*xm1**2,1d0*xm2**2)/am2/2
1035 x(4)=sqrt(ru**2+xm1**2)
1036 y(4)=sqrt(ru**2+xm2**2)
1042 ru=xlam(1d0*r**2,1d0*am2**2,1d0*xm3**2)/r/2
1044 z(4)=sqrt(ru**2+am2**2)
1046 CALL bostdq(-1,z,x,x)
1047 CALL bostdq(-1,z,y,y)
1052 z(4)=sqrt(ru**2+xm3**2)
1054 CALL bostdq(-1,peta,x,x)
1055 CALL bostdq(-1,peta,y,y)
1056 CALL bostdq(-1,peta,z,z)
1066 CALL filhep(0,1,id1,k,k,0,0,phot1,ym1,.true.)
1067 CALL filhep(0,1,id2,k,k,0,0,phot2,ym2,.true.)
1068 CALL filhep(0,1,id3,k,k,0,0,phot3,ym3,.true.)
1074 SUBROUTINE tauk0s(PETA,K)
1081 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
1082 * ,ampiz,ampi,amro,gamro,ama1,gama1
1083 * ,amk,amkz,amkst,gamkst
1085 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
1086 * ,ampiz,ampi,amro,gamro,ama1,gama1
1087 * ,amk,amkz,amkst,gamkst
1090 COMMON /taupos/ np1,np2
1092 REAL RRR(1),BRSUM(3)
1093 REAL PHOT1(4),PHOT2(4)
1096 real*8 r,peta(4),xm1,xm2,xlam
1099 xlam(a,b,c)=sqrt(abs((a-b-c)**2-4.0*b*c))
1109 brsum(3)=brsum(2)+0.237
1112 IF(rrr(1).LT.brsum(1))
THEN
1117 ELSEIF(rrr(1).LT.brsum(2))
THEN
1130 r=sqrt(peta(4)**2-peta(3)**2-peta(2)**2-peta(1)**2)/2d0
1132 r=sqrt(abs(r**2-xm1**2))
1141 CALL bostdq(-1,peta,x,x)
1142 CALL bostdq(-1,peta,y,y)
1151 CALL filhep(0,1,id1,k,k,0,0,phot1,ym1,.true.)
1152 CALL filhep(0,1,id2,k,k,0,0,phot2,ym2,.true.)
1157 subroutine bostdq(idir,vv,pp,q)
1169 implicit DOUBLE PRECISION (a-h,o-z)
1171 DOUBLE PRECISION v(4),p(4),q(4),pp(4),vv(4)
1177 amv=(v(4)**2-v(1)**2-v(2)**2-v(3)**2)
1178 if (amv.le.0d0)
then
1179 write(6,*)
'bosstv: warning amv**2=',amv
1182 if (idir.eq.-1)
then
1183 q(4)=( p(1)*v(1)+p(2)*v(2)+p(3)*v(3)+p(4)*v(4))/amv
1184 wsp =(q(4)+p(4))/(v(4)+amv)
1185 elseif (idir.eq.1)
then
1186 q(4)=(-p(1)*v(1)-p(2)*v(2)-p(3)*v(3)+p(4)*v(4))/amv
1187 wsp =-(q(4)+p(4))/(v(4)+amv)
1189 write(nout,*)
' >>> boostv: wrong value of idir = ',idir