56 parameter(memor=8000000)
57 parameter(nmxhep=2000)
61 INTEGER*4 ibadev,lepin,interaction,maxievt
62 REAL*4 ppxyz(3),ci,vdecy(4),bb(3),brf(3),xm(3),pm(3),ph(3)
63 COMMON /taupos / npa,npb
64 common/beri/jally,jein
67 common/sbeam/ pnumber,neutype,
vect(3),gkin(3),mestype,g4mes(4)
68 INTEGER jally(30),jarry(30),irawhead(11),keylist(50)
69 DOUBLE PRECISION hh(4)
70 INTEGER*4 daluaef(200),iprot
73 common/ludat3/mdcy(500,3),mdme(2000,2),brat(2000),kfdp(2000,5)
77 COMMON /polariz/pol(4000,3)
80 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
88 parameter(lux_level=4)
89 INTEGER*4 jtau(100),jpri(100),jstro(100)
91 common/jettagl/jtau,jpri,jstro
92 common/ntupla/ftuple,isfirst
93 common/beam/spec(icento)
94 COMMON /maxspec/rmaxspec,rintspec
95 common/sav/xminsav(icento),xmaxsav(icento),yminsav(icento),
96 & ymaxsav(icento),q2minsav(icento),q2maxsav(icento),
97 & w2minsav(icento),w2maxsav(icento),parimax(icento),
98 & ppsave(icento,3,4,5),paricor(icento),
index,sigmasav(icento),
104 common/foreficass/ievt
108 DOUBLE PRECISION phep,vhep
109 common/
hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
110 &jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
114 common/cfread/space(5000)
115 common/mykeys/ievar,if5cc,ineut,iinte,iferm,iflat,icoun,
116 & refix,imudo,ikat1,ikat2,ikat3,ikat4,ikat5,ikat6,
117 & inevt,ijak1,ijak2,iitdk,rptau,rxk0d,ntgr,idimuon,iglu,
118 & iqden,lome(2),ifiles,iccha,iseed,idsubs,ionem,ehac,ipsel,
124 parameter(charmsens=10000)
130 parameter(nnq=1000000)
132 dimension lq(nnq),iq(nnq),q(nnq)
133 equivalence(q(1),iq(1),lq(9),jstruc(8))
134 COMMON /quest/iquest(100)
135 COMMON /xqstor/ixevt,ifence(16),jgeev,jstruc(99),jrefer(100),
138 common/mzioall/iogenf
144 common/wlist/ww1,ww2,ww3,ww5
145 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
146 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
148 REAL*4 vnpalife(1000)
149 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
151 CHARACTER *8 ftags(isiz)
172 CALL rluxgo(lux_level,iseed,0,0)
175 IF (abs(lepin).EQ.14)
THEN
181 IF (idsubs.EQ.0)
THEN
182 IF (idimuon.EQ.2)
THEN
264 brat(io)=brat(io)*ra/r1m
270 brat(io)=brat(io)*rb/r2m
276 brat(io)=brat(io)*rc/r3m
282 brat(io)=brat(io)*rd/r4m
296 IF (idsubs.EQ.1)
THEN
298 ELSEIF (idsubs.EQ.2)
THEN
322 CALL hropen(1,
'histos',
'jetta.paw',
'N',1024,istat)
323 CALL hcdir(
'//histos',
' ')
325 WRITE(*,*)
'+++MAIN: WARNING, HROPEN FAILED'
390 ftags(iof1+3)=
'PVXRF'
391 ftags(iof1+4)=
'PVYRF'
392 ftags(iof1+5)=
'PVZRF'
396 ftags(iof1+7)=
'CHARM'
402 ftags(iof1+10)=
'CHARLEN'
404 ftags(iof1+11)=
'CHARTYP'
406 ftags(iof1+12)=
'CHARP'
407 ftags(iof1+13)=
'CHARE'
409 ftags(iof1+14)=
'PNUMB'
411 ftags(iof1+15)=
'CHARPX'
412 ftags(iof1+16)=
'CHARPY'
413 ftags(iof1+17)=
'CHARPZ'
473 ftags(iof2+3)=
'PTMOP'
475 ftags(iof2+4)=
'PTHOP'
477 ftags(iof2+5)=
'THEMOP'
479 ftags(iof2+6)=
'THEHOP'
481 ftags(iof2+7)=
'SIGMAPB'
489 CALL hbookn(11,
'X-sect',isiz,
'//histos',50000,ftags)
543 IF (lst(36).EQ.1) lst(34)=1
546 CALL
gentable(0,lepin,energy_fix,0.,interaction)
549 IF (lome(1).LT.lome(2))
THEN
557 CALL vzero(ftuple,isiz)
559 IF (lepin.EQ.16) neuforce=51
560 IF (lepin.EQ.14) neuforce=51
561 IF (lepin.EQ.-14) neuforce=52
562 IF (lepin.EQ.12) neuforce=49
563 IF (lepin.EQ.-12) neuforce=50
572 IF (lst(17).GT.0)
THEN
577 CALL
getneu(ipnumber,neutype,
vect,gkin, mestype,g4mes,
579 IF (istatus.NE.4)
THEN
582 WRITE(*,*)
' END OF NEUTRINO BEAMDATA:RELOOP'
589 CALL
gethneu(ipnumber,neutype,
vect,gkin, mestype,g4mes,
604 IF (lepin.EQ.16.AND.neutype.NE.51) goto 39
605 IF (lepin.EQ.14.AND.neutype.NE.51) goto 39
606 IF (lepin.EQ.-14.AND.neutype.NE.52) goto 39
607 IF (lepin.EQ.12.AND.neutype.NE.49) goto 39
608 IF (lepin.EQ.-12.AND.neutype.NE.50) goto 39
610 ptest=
sqrt(gkin(1)**2+gkin(2)**2+gkin(3)**2)
611 IF (ptest.LE.3.5.AND.lepin.EQ.16) goto 39
614 IF (pfin.EQ.0) goto 39
632 IF( lst(33).EQ.1) CALL
fermii(ppxyz)
640 rnuckin2=
p(2,1)**2+
p(2,2)**2+
p(2,3)**2
641 p(2,4)=
sqrt( rnuckin2 +
p(2,4)**2)
654 IF (icrack.NE.0)
THEN
655 WRITE(*,*)
'+++MAIN: ICRACK SAFETY TRAPPED'
659 IF (lst(21).NE.0)
THEN
660 IF (lst(21).NE.3131)
WRITE (*,10100) lst(21),ibadev
661 10100
FORMAT (/,10
x,
'!!!!!! LST(21)=',i10,
' AFTER ',i2,
' CALL TO LEPTO')
668 IF (abs(
p(2,3)+
p(1,3)).LT.0.01)
THEN
669 WRITE(*,*)
'ERROR CMS FRAME!! 28,29=',lst(28),lst(29)
673 IF (lst(32).EQ.1)
THEN
679 CALL
lurobo(0.0,0.0,bb(1),bb(2),bb(3))
691 frac=qm2*ww1 + (2.*ee*(ee-u) - 0.5*qm2)*ww2 - 0.5/rmm**2*(2.*
692 + rmm*ee*qq2 - nu*qm2)*ww3 - rml**2/rmm*ee*ww5
694 factk=2.*ww1 -ww2 - ee/rmm*ww3 +(ee-u)/rmm*ww5
695 factp=2.*ee/rmm*ww2 - qm2/2./rmm**2*(ww3+ww5)
698 pol(4,i)=rml*(factk*
p(1,i)+factp*
p(2,i))/frac
704 pmodul=pmodul+pol(4,i)**2
706 IF(pmodul.GT.1.05)
WRITE(*,*)
'PMODUL>1 ',
sqrt(pmodul)
709 CALL ludbrb(1,4,0.,0.,dble(-bb(1)),dble(-bb(2)),dble(-bb(3)))
713 IF (lst(32).EQ.2)
THEN
721 IF (lst(36).EQ.1.AND.lepin.EQ.16)
THEN
726 IF(abs(k(i,2)).EQ.15)
THEN
738 IF(k(npa,1).EQ.5)
THEN
740 ELSEIF(k(npa,1).NE.4)
THEN
741 v(npa,5)=-pmas(kc,4)*
log(
rlu(0))
744 vdecy(j)=v(npa,j)+v(npa,5)*
p(npa,j)/
p(npa,5)
756 CALL ludbrb(1,4,0.,0.,dble(bb(1)),dble(bb(2)),dble(bb(3)))
772 IF(abs(k(ii,2)).NE.16.AND.abs(k(ii,2)).NE.14.AND. abs(k(ii,
775 ftuple(iof1+2+ik)=ftuple(iof1+2+ik)+
p(ii,ik)
783 CALL
lurobo(0.0,0.0,-bb(1),-bb(2),-bb(3))
803 IF (k(ii,2).EQ.13)
THEN
805 ftuple(61+ik)=
p(ii,ik)
807 ELSEIF (k(ii,2).EQ.11)
THEN
809 ftuple(80+ik)=
p(ii,ik)
813 IF(abs(k(ii,2)).NE.16.AND.abs(k(ii,2)).NE.14.AND. abs(k(ii,
816 ftuple(57+ik)=ftuple(57+ik)+
p(ii,ik)
829 IF (iaki.EQ.92.OR.iaki.EQ.91)
THEN
832 IF (estr.GT.ehac)
THEN
838 WRITE(*,*)
'+++MAIN: STRING ENERGY=0,EVT=',ievt
845 + .OR.iaki.EQ.4122)
THEN
846 IF (idsubs.EQ.0)
THEN
850 IF (iaki.EQ.411.OR.iaki.EQ.431.OR.iaki.EQ.4122)
THEN
855 IF (iaki.EQ.431) ichm=ichm+1
859 IF (iaki.EQ.abs(ipsel))
THEN
866 IF (k(ii,2).EQ.13)
THEN
878 IF (k(ii,2).EQ.-211)
THEN
886 IF (ipselfound.EQ.0..AND.ipsel.NE.0)
THEN
887 ipselthrow=ipselthrow+1
891 IF (idimuon.GE.1.AND.ichm.LT.1)
THEN
895 IF (idimuon.GE.2.AND.imu.LE.imureq)
THEN
903 IF ((imu.GE.1.AND.lst(38).EQ.2).OR.
904 + (imu.EQ.0.AND.lst(38).EQ.1))
THEN
913 brf(jij)=(
p(1,jij)+
p(2,jij))/(
p(1,4)+
p(2,4))
916 CALL ludbrb(1,4,0.,0.,dble(-brf(1)),dble(-brf(2)),dble(-brf(3)))
922 ftuple(51+jij)=
p(4,jij)
923 ftuple(55)=ftuple(55)+
p(4,jij)**2
925 ftuple(55)=
sqrt(ftuple(55))
926 ftuple(51)=
sqrt(polarx(1)**2+polarx(2)**2+polarx(3)**2)
928 ftuple(56)=(
p(1,1)*
p(4,1)+
p(1,2)*
p(4,2)+
p(1,3)*
p(4,3)) /
p(1,4)/
932 ftuple(57)=(polarx(1)*ftuple(52)+polarx(2)*ftuple(53)+
933 + polarx(3)* ftuple(54))/ftuple(55)/ftuple(51)
936 CALL ludbrb(1,4,0.,0.,dble(brf(1)),dble(brf(2)),dble(brf(3)))
940 popi=
p(ihm,1)**2+
p(ihm,2)**2+
p(ihm,3)**2
941 tvar=-(v(ihm,1)*
p(ihm,1)+v(ihm,2)*
p(ihm,2)+
942 + v(ihm,3)*
p(ihm,3))/popi
945 + (v(ihm,1)+
p(ihm,1)*tvar)**2+
946 + (v(ihm,2)+
p(ihm,2)*tvar)**2+
947 + (v(ihm,3)+
p(ihm,3)*tvar)**2 )
951 ftuple(iof1+8)=
sqrt(
p(ihm,1)**2+
p(ihm,2)**2+
p(ihm,3)**2)
952 ftuple(iof1+9)=
sqrt(
p(ihmp,1)**2+
p(ihmp,2)**2+
p(ihmp,3)**2)
957 popi=
p(ihp,1)**2+
p(ihp,2)**2+
p(ihp,3)**2
958 tvar=-(v(ihp,1)*
p(ihp,1)+v(ihp,2)*
p(ihp,2)+
959 + v(ihp,3)*
p(ihp,3))/popi
962 + (v(ihp,1)+
p(ihp,1)*tvar)**2+
963 + (v(ihp,2)+
p(ihp,2)*tvar)**2+
964 + (v(ihp,3)+
p(ihp,3)*tvar)**2 )
968 temp=
sqrt(
p(4,1)**2+
p(4,2)**2+
p(4,3)**2)
969 ftuple(iof1+1)=
p(4,4)
970 ftuple(iof1+2)=(polarx(1)*
p(4,1)+polarx(2)*
p(4,2)+
974 CALL hfill(1000,
p(1,4),0.,1.)
975 CALL hfill(1001,
sqrt(rnuckin2),0.,1.)
976 CALL hfill(1002,
sqrt(w2),0.,1.)
977 CALL hfill(1003,
sqrt(q2),0.,1.)
978 CALL hfill(1006,
p(1,4),0.,ftuple(1))
989 ftuple(i+10)=pol(4,i)
997 IF ((i.EQ.4.AND.v(i,5).EQ.0).OR.(k(i,1).LE.10.AND.i.GT.4))
THEN
1002 IF (k(i,3).EQ.2)
THEN
1005 ftuple(75+ij)=
p(i,ij)
1009 IF (k(i,2).EQ.91)
THEN
1017 IF (k(i,2).EQ.92.OR.k(i,2).EQ.91)
THEN
1019 ftuple(16+ij)=
p(i,ij)
1024 IF (k(i,2).EQ.13)
THEN
1031 IF (k(i,2).EQ.15)
THEN
1033 CALL hfill(1004,
p(i,4),0.,1.)
1036 IF ((k(i,2).LT.10).AND.k(i,3).EQ.0)
THEN
1038 CALL hfill(1005,
p(i,4),0.,1.)
1047 IF (abs(chk1).GT.relerr.OR.abs(chk2).GT.relerr)
THEN
1049 WRITE(*,*)
'ERROR IN CHK',chk1,chk2
1065 IF(ievt.GE.lome(1).AND.ievt.LE.lome(2))
THEN
1066 WRITE(*,*)
'**********************************'
1067 WRITE(*,*)
'********LOOK AT ME****************'
1068 WRITE(*,*)
'EVENT NUMBER:',ievt
1069 WRITE(*,*)
'**********************************'
1074 IF (
mod(ievt,100).EQ.0)
THEN
1075 WRITE(*,*)
'EVENTS=',ievt,
'SIGMA=',parl(24)
1079 test=
p(1,4)+
p(2,4)-ftuple(31)-
p(4,4)
1081 IF(
test.LT.-0.2)
THEN
1082 WRITE(*,*)
'...HERE BOZZO:EVENT/LST(24)',ievt,lst(24)
1089 IF (jgeev.NE.0) CALL mzdrop(ixstor,jgeev,
'.')
1090 CALL mzbook(ixevt,jgeev,jgeev,2,
'GEEV',4,4,0,2,0)
1093 CALL mzbook(ixevt,jgelu,jgeev,-2,
'GELU',
n,
n,0,2,0)
1096 CALL mzbook(ixevt,jgeln,jgelu,-ias,
'GELN',0,0,16,3,0)
1098 q(jgeln+iat)=k(ias,iat)
1099 q(jgeln+iat+5)=
p(ias,iat)
1100 q(jgeln+iat+10)=v(ias,iat)
1101 q(jgeln+16)=daluaef(ias)
1104 CALL zverif(ixevt,iflrtn,
'Verification')
1110 CALL fzout(lunfz,ixevt,0,1,
'Z',2,4,keylist)
1111 CALL fzout(lunfz,ixevt,jgeev,0,
' ',2,1,1990)
1112 CALL fzout(lunfz,ixevt,0,0,
'Z',2,1,-1)
1113 IF(ievt.GE.lome(1).AND.ievt.LE.lome(2))
THEN
1114 WRITE(*,*)
'**********************************'
1121 phl=
sqrt(ph(1)**2+ph(2)**2+ph(3)**2)
1122 pml=
sqrt(pm(1)**2+pm(2)**2+pm(3)**2)
1125 IF (phl.GT.0.AND.pml.GT.0)
THEN
1129 ftuple(iof2+5)=acos(pm(3)/pml)
1135 ftuple(iof2+6)=acos(ph(3)/phl)
1138 ftuple(iof2+7)=xsect
1139 ftuple(iof1+14)=pnumber
1141 IF(ievt.LE.10000)
THEN
1145 WRITE(88,5341) ievt,
n
1146 WRITE(88,5342) ineut,interaction,lst(22),ftuple(4)
1148 write(88,5343) ms,k(ms,1),k(ms,2),k(ms,3),k(ms,4),
1149 +k(ms,5),
p(ms,1),
p(ms,2),
p(ms,3),
p(ms,4)
1151 5341
FORMAT(1
x,i6,1
x,i6)
1152 5342
FORMAT(1
x,3i6,e15.7)
1153 5343
format(1
x,i3,5i6,4e15.7)
1158 jarry(jein)=jarry(jein)+1
1159 IF (ievt.LT.maxievt) goto 10
1162 IF (lst(36).EQ.1)
THEN
1163 CALL
dexay(100,polarx)
1165 ijeje=ijeje+jarry(iji)
1166 ijaja=ijaja+jally(iji)
1169 WRITE(*,*)
'JARRY-JALLY JAKER SAYS',float(jarry(iji))/ijeje,
1170 + float(jally(iji))/ijaja,
'FOR JAK',iji
1173 CALL fzrun(lunfz,-99999,0,0)
1175 CALL hcdir(
'//histos',
' ')
1176 CALL hldir(
'//histos',
'T')
1177 CALL hrout(11,icycle,
' ')
1178 CALL hrend(
'histos')
1179 WRITE(*,*)
' MISSED MUONS in DIMUON GENERATION:',mumiss,
' IN ',
1180 + ievt,
' EVENTS (',float(mumiss)/float(ievt),
'%)'
1181 WRITE(*,*)
' REJECTED EVENTS FOR EHAD CUT:',iehac,
' IN ',
1182 + ievt,
' EVENTS (',float(iehac)/float(ievt),
'%)'
1183 WRITE(*,*)
' REJECTED EVENTS FOR PARTICLE ID=',ipsel,
1185 + ievt,
' REJECTED',ipselthrow
1208 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
1209 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
1210 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
1211 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
1212 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
1213 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
1214 COMMON /lboost/
dbeta(2,3),stheta(2),sphi(2),pb(5),phir
1215 COMMON /ardat1/ para(40),msta(40)
1216 common/wlist/ww1,ww2,ww3,ww5
1219 COMMON /polariz/pol(4000,3)
1223 parameter(icento=100)
1227 parameter(lux_level=4)
1228 INTEGER*4 jtau(100),jpri(100),jstro(100)
1230 common/jettagl/jtau,jpri,jstro
1231 common/ntupla/ftuple,isfirst
1232 common/beam/spec(icento)
1233 COMMON /maxspec/rmaxspec,rintspec
1234 common/sav/xminsav(icento),xmaxsav(icento),yminsav(icento),
1235 & ymaxsav(icento),q2minsav(icento),q2maxsav(icento),
1236 & w2minsav(icento),w2maxsav(icento),parimax(icento),
1237 & ppsave(icento,3,4,5),paricor(icento),
index,sigmasav(icento),
1241 DOUBLE PRECISION dbetatmp(3)
1242 DOUBLE PRECISION dtheta,dphi,
dbeta,detot,dari29,dari30
1245 DATA nummis,nwarn/0,10/,dari29,dari30/2*0.d0/
1259 IF(lst(17).NE.0.AND.lst(2).GT.0)
THEN
1264 IF(isfirst.EQ.1)
THEN
1271 p(i,4)=
sqrt(
p(i,1)**2+
p(i,2)**2+
p(i,3)**2+
p(i,5)**2)
1275 25
p(ii,j)=psave(3,ii,j)
1279 60
dbeta(1,j)=(dble(
p(1,j))+dble(
p(2,j)))/
1280 + (dble(
p(1,4))+dble(
p(2,4)))
1281 IF (isfirst.EQ.1)
THEN
1284 70 dbetatmp(j)=
dbeta(1,j)
1289 CALL ludbrb(0,0,0.,-sphi(1),0.d0,0.d0,0.d0)
1291 CALL ludbrb(0,0,-stheta(1),0.,0.d0,0.d0,0.d0)
1293 parl(21)=2.*(
p(1,4)*
p(2,4)-
p(1,3)*
p(2,3))
1298 80
p(i,j)=psave(3,i,j)
1299 90
IF(psave(3,1,3).LT.0.)
p(i,3)=-psave(3,i,3)
1304 IF (w2.LT.lst(35))
THEN
1310 IF(
mod(ierr31,5000).EQ.0)
WRITE(*,*)
'STATUS 21: CASE 3131',ierr31
1317 IF(lst(21).NE.0.OR.lst(2).LE.0.OR.lst(7).EQ.-1)
THEN
1321 IF(pari(29).LT.0.5)
THEN
1333 IF(lst(17).EQ.0)
THEN
1336 100 psave(3,i,j)=
p(i,j)
1337 110
IF(psave(3,1,3).LT.0.) psave(3,i,3)=-
p(i,3)
1338 CALL ludbrb(0,0,0.,0.,0.d0,0.d0,-
dbeta(1,3))
1343 120 psave(2,i,j)=
p(i,j)
1347 IF(lst(8).GE.2.AND.
mod(lst(8),10).NE.9) CALL
lshowr(0)
1350 detot=dble(
p(1,4))-dble(
p(4,4))+dble(
p(2,4))
1351 dbeta(2,1)=-dble(
p(4,1))/detot
1352 dbeta(2,2)=-dble(
p(4,2))/detot
1353 dbeta(2,3)=(dble(
p(1,3))-dble(
p(4,3))+dble(
p(2,3)))/detot
1357 CALL ludbrb(0,0,-stheta(2),0.,0.d0,0.d0,0.d0)
1361 130 psave(1,i,j)=
p(i,j)
1376 IF(lst(8).EQ.1.OR.lst(8)/10.EQ.1.OR.
mod(lst(8),10).EQ.9)
THEN
1382 IF(srlu.GT.qqb+qg)
THEN
1386 ELSEIF(srlu.GT.qqb)
THEN
1387 IF(lst(8).EQ.9)
THEN
1396 IF(lst(8).EQ.9.AND.lst(21).EQ.0)
THEN
1397 IF(
plu(5,11).LT.q2*para(20))
THEN
1400 CALL lqevar(k(5,2),k(7,2))
1404 IF(lst(21).NE.0) goto 170
1409 IF(lst(21).NE.0) goto 210
1418 IF(lst(8).LE.1.OR.
mod(lst(8),10).EQ.9)
THEN
1420 IF(parl(3).GT.1.
e-03)
THEN
1422 CALL ludbrb(
ns,
n,0.,-
phi,0.d0,0.d0,0.d0)
1423 CALL ludbrb(
ns,
n,atan(2.*
pt/
sqrt(w2)),
phi,0.d0,0.d0,0.d0)
1428 IF(mstu(24).NE.0)
THEN
1429 IF(lst(3).GE.1)
WRITE(6,*)
' LUPREP ERROR MSTU(24)= ',mstu(24)
1432 ELSEIF(lst(24).EQ.1)
THEN
1435 IF(lst(21).NE.0)
THEN
1455 IF(lst(21).NE.0)
THEN
1458 IF(
mod(ierr21,100).EQ.0)
WRITE(*,*)
'ERROR 21:',ierr21
1464 IF(
p(i,5).LT.0.) goto 230
1465 energy=
sqrt(dble(
p(i,5))**2+dble(
p(i,1))**2+dble(
p(i,2))**2+
1467 p2=dble(
p(i,4))**2-dble(
p(i,1))**2-dble(
p(i,2))**2-dble(
p(i,3))
1469 IF(abs(
energy-
p(i,4))/(psave(3,1,4)+psave(3,2,4)).GT.paru(11))
1485 IF(lst(23).EQ.2) parl(24)=parl(24)*dari30/dari29
1490 IF(lst(7).EQ.1)
THEN
1491 IF(lst(34).EQ.1)
THEN
1497 IF(mstu(24).NE.0)
THEN
1498 WRITE(*,*)
' ERROR FROM JETSET, NEW EVENT MADE'
1509 IF(lst(17).EQ.0)
THEN
1510 IF(lst(5).GE.2) CALL
lframe(lst(5),0)
1514 250
p(i,j)=psave(lst(28),i,j)
1515 IF(lst(6).EQ.1.AND.lst(28).GE.2)
THEN
1517 CALL ludbrb(0,0,0.,phir,0.d0,0.d0,0.d0)
1521 IF(lst(5).GE.2)
THEN
1523 IF (
dbeta(1,3).NE.0)
THEN
1524 CALL
lframe(lst(5),lst(6))
1526 WRITE(*,*)
'0 DBETA!!!'
1528 dbeta(1,j)=dbetatmp(j)
1530 CALL
lframe(lst(5),lst(6))
1531 WRITE(*,*)
'1ST ATTEMPT RECOVERY',phir
1533 WRITE(*,*)
'1ST ATTEMPT RECOVERY ENDED',phir
1536 IF (abs(
p(2,3)+
p(1,3)).LT.0.2)
THEN
1537 WRITE(*,*)
'LEPTO ERROR CMS FRAME!!',phir
1540 dbeta(1,j)=dbetatmp(j)
1542 WRITE(*,*)
' TRY RECOVERY...',dbetatmp
1544 CALL
lframe(lst(5),lst(6))
1550 IF(
mod(lst(4),10).EQ.0) k(4,1)=21
1554 10000
FORMAT(
' WARNING: TOO LARGE NUMERICAL MISMATCH IN ',
1555 +
'PARTICLE ENERGY-MOMENTUM-MASS',
1556 +/,3
x,
'I K(I,1) ..2) P(I,1) P(I,2) P(I,3)',
1557 +
' P(I,4) P(I,5) MASS ENERGY',/,i4,2i6,7f8.3,/,
1558 +
' EVENT NO.',i8,
' REGENERATED. ONLY FIRST',i5,
' WARNINGS PRINTED')
1570 aaa=pp(4)**2-pp(3)**2-pp(2)**2-pp(1)**2
1571 IF(aaa.NE.0.0) aaa=aaa/
sqrt(abs(aaa))
1583 IMPLICIT REAL*8 (
a-h,o-
z)
1585 aaa=pp(4)**2-pp(3)**2-pp(2)**2-pp(1)**2
1587 IF(aaa.NE.0.0) aaa=aaa/
sqrt(abs(aaa))
1599 IMPLICIT DOUBLE PRECISION (
a-h,o-
z)
1600 DATA pi /3.141592653589793238462643d0/
1602 IF(abs(
y).LT.abs(
x))
THEN
1604 IF(
x.LE.0d0) the=pi-the
1608 IF(
y.LT.0d0) the=2d0*pi-the
1618 IMPLICIT DOUBLE PRECISION (
a-h,o-
z)
1619 DATA pi /3.141592653589793238462643d0/
1621 IF(abs(
y).LT.abs(
x))
THEN
1623 IF(
x.LE.0d0) the=pi-the
1638 IMPLICIT DOUBLE PRECISION (
a-h,o-
z)
1639 dimension pvec(4),qvec(4),rvec(4)
1661 REAL*4 pvec(4),qvec(4),rvec(4)
1685 pty = vin(2)+pin(2)/pin(3)*
dz
1686 ptx = vin(1)+pin(1)/pin(3)*
dz
1696 REAL pi,pim,qs,qm,w,gs
1705 IF (
s.GT.4.*pim**2)
THEN
1706 qs=
sqrt(abs(abs(
s/4.-pim**2)+(
s/4.-pim**2))/2.0)
1707 qm=
sqrt(m**2/4.-pim**2)
1709 gs=g*(m/w)*(qs/qm)**3
1713 bwig=m**2/cmplx(m**2-
s,-m*gs)
1732 IF (
s.GT.(xm1+xm2)**2)
THEN
1733 qs=
sqrt(abs((
s -(xm1+xm2)**2)*(
s -(xm1-xm2)**2)))/
sqrt(
s)
1734 qm=
sqrt(abs((m**2-(xm1+xm2)**2)*(m**2-(xm1-xm2)**2)))/m
1736 gs=g*(m/w)**2*(qs/qm)**3
1751 REAL pi,pim,qs,qm,w,gs,mk
1753 p(
a,b,c)=
sqrt(abs(abs(((
a+b-c)**2-4.*
a*b)/4./
a)
1754 + +(((
a+b-c)**2-4.*
a*b)/4./
a))/2.0)
1763 qs=
p(
s,pim**2,mk**2)
1764 qm=
p(m**2,pim**2,mk**2)
1766 gs=g*(m/w)*(qs/qm)**3
1767 bwigs=m**2/cmplx(m**2-
s,-m*gs)
1777 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
1778 COMMON /lminui/ xkin(4),ukin(4),wkin(4),ain(4),
bin(4), maxfin,
1779 +relup,relerr,reler2,fcnmax
1781 common/linpatch/ncalls,ncall
1784 IF (imyfirst.EQ.0)
THEN
1817 SUBROUTINE choice(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
1818 + amrx,gamrx,amra,gamra,amrb,gamrb)
1819 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
1820 + ,ampiz,ampi,amro,gamro,ama1,gama1
1821 + ,amk,amkz,amkst,gamkst
1823 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
1824 + ,ampiz,ampi,amro,gamro,ama1,gama1
1825 + ,amk,amkz,amkst,gamkst
1841 ELSEIF(mnum.EQ.1)
THEN
1850 ELSEIF(mnum.EQ.2)
THEN
1859 ELSEIF(mnum.EQ.3)
THEN
1868 ELSEIF(mnum.EQ.4)
THEN
1877 ELSEIF(mnum.EQ.5)
THEN
1886 ELSEIF(mnum.EQ.6)
THEN
1895 ELSEIF(mnum.EQ.7)
THEN
1904 ELSEIF(mnum.EQ.8)
THEN
1913 ELSEIF(mnum.EQ.101)
THEN
1922 ELSEIF(mnum.EQ.102)
THEN
1942 IF (rr.LE.prob1)
THEN
1944 ELSEIF(rr.LE.(prob1+prob2))
THEN
1959 prob3=1.0-prob1-prob2
1970 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
1971 COMMON / idfc / idff
1973 COMPLEX hj(4),hjc(4)
1976 det2(i,j)=aimag(hjc(i)*hj(j)-hjc(j)*hj(i))
1981 IF (ktom.EQ.1.OR.ktom.EQ.-1)
THEN
1982 sign= idff/abs(idff)
1983 ELSEIF (ktom.EQ.2)
THEN
1984 sign=-idff/abs(idff)
1986 print *,
'STOP IN CLAXI: KTOM=',ktom
1991 10 hjc(i)=conjg(hj(i))
1992 pia(1)= -2.*pn(3)*det2(2,4)+2.*pn(4)*det2(2,3)
1993 pia(2)= -2.*pn(4)*det2(1,3)+2.*pn(3)*det2(1,4)
1994 pia(3)= 2.*pn(4)*det2(1,2)
1995 pia(4)= 2.*pn(3)*det2(1,2)
1998 20 pia(i)=pia(i)*sign
2014 b=
REAL( HJ(4)*AIMAG(HJ(4)) - HJ(3)*AIMAG(HJ(3))
& - HJ(2)*AIMAG(HJ(2)) - HJ(1)*AIMAG(HJ(1)) )
2019 SUBROUTINE clvec(HJ,PN,PIV)
2029 hn= hj(4)*cmplx(pn(4))-hj(3)*cmplx(pn(3))
2030 hh=
REAL(hj(4)*conjg(hj(4))-hj(3)*conjg(hj(3))
2031 $ -hj(2)*conjg(hj(2))-hj(1)*conjg(hj(1)))
2033 10 piv(i)=4.*
REAL(hn*conjg(hj(i)))-2.*
hh*pn(i)
2040 SUBROUTINE curr(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
2048 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
2049 + ,ampiz,ampi,amro,gamro,ama1,gama1
2050 + ,amk,amkz,amkst,gamkst
2052 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
2053 + ,ampiz,ampi,amro,gamro,ama1,gama1
2054 + ,amk,amkz,amkst,gamkst
2055 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
2056 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
2058 COMMON /arbit/ arflat,aromeg
2059 REAL pim1(4),pim2(4),pim3(4),pim4(4),paa(4)
2063 REAL aa(4,4),pp(4,4)
2064 DATA pi /3.141592653589793238462643/
2066 bwign(
a,xm,xg)=1.0/cmplx(
a-xm**2,xm*xg)
2081 coef1=2.0*
sqrt(3.0)/fpi**2*arflat
2087 hadcur(k)=cmplx(0.0)
2088 paa(k)=pim1(k)+pim2(k)+pim3(k)+pim4(k)
2098 qq=paa(4)**2-paa(3)**2-paa(2)**2-paa(1)**2
2101 sk=(pp(k,4)+pim4(4))**2-(pp(k,3)+pim4(3))**2 -(pp(k,2)+
2102 + pim4(2))**2-(pp(k,1)+pim4(1))**2
2112 denom=(paa(4)-pp(l,4))**2-(paa(3)-pp(l,3))**2 -(paa(2)-
2113 + pp(l,2))**2-(paa(1)-pp(l,1))**2
2118 aa(i,j)=aa(i,j) -sig*(paa(i)-2.0*pp(l,i))*(paa(j)-
2129 IF (k.EQ.3) fix=-2.0
2132 hadcur(i)= hadcur(i)+cmplx(fix*coef1)*
form1*aa(i,j)*
2159 IF (k.EQ.4) sign= 1.0
2160 qqa=qqa+sign*(paa(k)-pa(k))**2
2161 ss23=ss23+sign*(pb(k) +pim3(k))**2
2162 ss24=ss24+sign*(pb(k) +pim4(k))**2
2163 ss34=ss34+sign*(pim3(k)+pim4(k))**2
2164 qp1p2=qp1p2+sign*(paa(k)-pa(k))*pb(k)
2165 qp1p3=qp1p3+sign*(paa(k)-pa(k))*pim3(k)
2166 qp1p4=qp1p4+sign*(paa(k)-pa(k))*pim4(k)
2167 p1p2=p1p2+sign*pa(k)*pb(k)
2168 p1p3=p1p3+sign*pa(k)*pim3(k)
2169 p1p4=p1p4+sign*pa(k)*pim4(k)
2172 form2=coef2*(bwign(qq,amro,gamro)+elpha*bwign(qq,amrop,
2176 form3=bwign(qqa,amom,gamom)
2179 hadcur(k)=hadcur(k)+
form2*
form3*( pb(k)*(qp1p3*p1p4-qp1p4*
2180 + p1p3) +pim3(k)*(qp1p4*p1p2-qp1p2*p1p4) +pim4(k)*(qp1p2*
2181 + p1p3-qp1p3*p1p2) )
2189 qq=paa(4)**2-paa(3)**2-paa(2)**2-paa(1)**2
2192 sk=(pp(k,4)+pim4(4))**2-(pp(k,3)+pim4(3))**2 -(pp(k,2)+
2193 + pim4(2))**2-(pp(k,1)+pim4(1))**2
2204 denom=(paa(4)-pp(l,4))**2-(paa(3)-pp(l,3))**2 -(paa(2)-
2205 + pp(l,2))**2-(paa(1)-pp(l,1))**2
2210 aa(i,j)=aa(i,j) -sig*(paa(i)-2.0*pp(l,i))*(paa(j)-
2221 hadcur(i)= hadcur(i)+cmplx(coef1)*
form1*aa(i,j)*(pp(k,j)-
2232 SUBROUTINE dadmaa(MODE,ISGN,HHV,PNU,PAA,PIM1,PIM2,PIPL,JAA)
2236 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
2237 + ,ampiz,ampi,amro,gamro,ama1,gama1
2238 + ,amk,amkz,amkst,gamkst
2240 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
2241 + ,ampiz,ampi,amro,gamro,ama1,gama1
2242 + ,amk,amkz,amkst,gamkst
2243 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
2244 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
2245 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
2246 REAL*4 gampmc ,gamper
2247 COMMON / inout / inut,iout
2249 REAL hv(4),paa(4),pnu(4),pim1(4),pim2(4),pipl(4)
2250 REAL pdum1(4),pdum2(4),pdum3(4),pdum4(4),pdum5(4)
2253 DATA pi /3.141592653589793238462643/
2266 CALL
dphsaa(wt,hv,pdum1,pdum2,pdum3,pdum4,pdum5,jaa)
2267 IF(wt.GT.wtmax/1.2) wtmax=wt*1.2
2271 ELSEIF(mode.EQ. 0)
THEN
2274 IF(iwarm.EQ.0) goto 40
2275 CALL
dphsaa(wt,hv,pnu,paa,pim1,pim2,pipl,jaa)
2282 IF(wt.GT.wtmax) nevovr=nevovr+1
2283 IF(rn*wtmax.GT.wt) goto 20
2285 costhe=-1.+2.*rrr(2)
2295 30 hhv(i)=-isgn*hv(i)
2298 ELSEIF(mode.EQ. 1)
THEN
2300 IF(nevraw.EQ.0)
RETURN
2301 pargam=swt/float(nevraw+1)
2303 IF(nevraw.NE.0) error=
sqrt(sswt/swt**2-1./float(nevraw))
2305 WRITE(iout, 10100) nevraw,nevacc,nevovr,pargam,rat,error
2313 10000
FORMAT(///1
x,15(5h*****)
2314 + /,
' *', 25
x,
'******** DADMAA INITIALISATION ********',9
x,1h*
2315 + /,
' *',e20.5,5
x,
'WTMAX = MAXIMUM WEIGHT ',9
x,1h*
2316 + /,1
x,15(5h*****)/)
2317 10100
FORMAT(///1
x,15(5h*****)
2318 + /,
' *', 25
x,
'******** DADMAA FINAL REPORT ******** ',9
x,1h*
2319 + /,
' *',i20 ,5
x,
'NEVRAW = NO. OF A1 DECAYS TOTAL ',9
x,1h*
2320 + /,
' *',i20 ,5
x,
'NEVACC = NO. OF A1 DECS. ACCEPTED ',9
x,1h*
2321 + /,
' *',i20 ,5
x,
'NEVOVR = NO. OF OVERWEIGHTED EVENTS ',9
x,1h*
2322 + /,
' *',e20.5,5
x,
'PARTIAL WTDTH (A1 DECAY) IN GEV UNITS ',9
x,1h*
2323 + /,
' *',f20.9,5
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',9
x,1h*
2324 + /,
' *',f20.8,5
x,
'RELATIVE ERROR OF PARTIAL WIDTH ',9
x,1h*
2325 + /,1
x,15(5h*****)/)
2326 40
WRITE(iout, 10200)
2327 10200
FORMAT(
' ----- DADMAA: LACK OF INITIALISATION')
2334 SUBROUTINE dadmel(MODE,ISGN,HHV,PNU,PWB,Q1,Q2,PHX)
2339 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
2340 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
2341 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
2342 + ,ampiz,ampi,amro,gamro,ama1,gama1
2343 + ,amk,amkz,amkst,gamkst
2345 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
2346 + ,ampiz,ampi,amro,gamro,ama1,gama1
2347 + ,amk,amkz,amkst,gamkst
2348 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
2349 REAL*4 gampmc ,gamper
2351 COMMON / inout / inut,iout
2352 REAL hhv(4),hv(4),pwb(4),pnu(4),q1(4),q2(4)
2353 REAL pdum1(4),pdum2(4),pdum3(4),pdum4(4),pdum5(4)
2356 DATA pi /3.141592653589793238462643/
2369 CALL
dphsel(wt,hv,pdum1,pdum2,pdum3,pdum4,pdum5)
2370 IF(wt.GT.wtmax/1.2) wtmax=wt*1.2
2374 ELSEIF(mode.EQ. 0)
THEN
2377 IF(iwarm.EQ.0) goto 40
2379 CALL
dphsel(wt,hv,pnu,pwb,q1,q2,phx)
2385 IF(wt.GT.wtmax) nevovr=nevovr+1
2386 IF(rn*wtmax.GT.wt) goto 20
2393 CALL
rotor2(thet,pnu,pnu)
2395 CALL
rotor2(thet,pwb,pwb)
2403 CALL
rotor2(thet,phx,phx)
2406 30 hhv(i)=-isgn*hv(i)
2409 ELSEIF(mode.EQ. 1)
THEN
2411 IF(nevraw.EQ.0)
RETURN
2412 pargam=swt/float(nevraw+1)
2414 IF(nevraw.NE.0) error=
sqrt(sswt/swt**2-1./float(nevraw))
2416 WRITE(iout, 10000) nevraw,nevacc,nevovr,pargam,rat,error
2424 10000
FORMAT(///1
x,15(5h*****)
2425 + /,
' *', 25
x,
'******** DADMEL FINAL REPORT ******** ',9
x,1h*
2426 + /,
' *',i20 ,5
x,
'NEVRAW = NO. OF EL DECAYS TOTAL ',9
x,1h*
2427 + /,
' *',i20 ,5
x,
'NEVACC = NO. OF EL DECS. ACCEPTED ',9
x,1h*
2428 + /,
' *',i20 ,5
x,
'NEVOVR = NO. OF OVERWEIGHTED EVENTS ',9
x,1h*
2429 + /,
' *',e20.5,5
x,
'PARTIAL WTDTH ( ELECTRON) IN GEV UNITS ',9
x,1h*
2430 + /,
' *',f20.9,5
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',9
x,1h*
2431 + /,
' *',f20.9,5
x,
'RELATIVE ERROR OF PARTIAL WIDTH ',9
x,1h*
2432 + /,
' *',25
x,
'COMPLETE QED CORRECTIONS INCLUDED ',9
x,1h*
2433 + /,
' *',25
x,
'BUT ONLY V-A CUPLINGS ',9
x,1h*
2434 + /,1
x,15(5h*****)/)
2435 40
WRITE(iout, 10100)
2436 10100
FORMAT(
' ----- DADMEL: LACK OF INITIALISATION')
2442 SUBROUTINE dadmkk(MODE,ISGN,HV,PKK,PNU)
2445 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
2446 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
2447 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
2448 * ,ampiz,ampi,amro,gamro,ama1,gama1
2449 * ,amk,amkz,amkst,gamkst
2451 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
2452 * ,ampiz,ampi,amro,gamro,ama1,gama1
2453 * ,amk,amkz,amkst,gamkst
2454 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
2455 REAL*4 gampmc ,gamper
2456 COMMON / inout / inut,iout
2457 REAL pkk(4),pnu(4),hv(4)
2458 DATA pi /3.141592653589793238462643/
2463 ELSEIF(mode.EQ. 0)
THEN
2466 ekk= (amtau**2+amk**2-amnuta**2)/(2*amtau)
2467 enu= (amtau**2-amk**2+amnuta**2)/(2*amtau)
2468 xkk=
sqrt(ekk**2-amk**2)
2478 qxn=pkk(4)*pnu(4)-pkk(1)*pnu(1)-pkk(2)*pnu(2)-pkk(3)*pnu(3)
2479 brak=(gv**2+ga**2)*(2*pxq*qxn-amk**2*pxn)
2480 & +(gv**2-ga**2)*amtau*amnuta*amk**2
2482 20 hv(i)=-isgn*2*ga*gv*amtau*(2*pkk(i)*qxn-pnu(i)*amk**2)/brak
2485 ELSEIF(mode.EQ. 1)
THEN
2487 IF(nevtot.EQ.0)
RETURN
2494 gamm=(gfermi*fkk)**2/(16.*pi)*amtau**3*
2496 $
sqrt((amtau**2-amk**2-amnuta**2)**2
2497 $ -4*amk**2*amnuta**2 )/amtau**2
2502 WRITE(iout, 10000) nevtot,gamm,rat,error
2509 10000
FORMAT(///1
x,15(5h*****)
2510 $ /,
' *', 25
x,
'******** DADMKK FINAL REPORT ********',9
x,1h*
2511 $ /,
' *',i20 ,5
x,
'NEVTOT = NO. OF K DECAYS TOTAL ',9
x,1h*,
2512 $ /,
' *',e20.5,5
x,
'PARTIAL WTDTH ( K DECAY) IN GEV UNITS ',9
x,1h*,
2513 $ /,
' *',f20.9,5
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',9
x,1h*
2514 $ /,
' *',f20.8,5
x,
'RELATIVE ERROR OF PARTIAL WIDTH (STAT.)',9
x,1h*
2515 $ /,1
x,15(5h*****)/)
2522 SUBROUTINE dadmks(MODE,ISGN,HHV,PNU,PKS,PKK,PPI,JKST)
2524 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
2525 + ,ampiz,ampi,amro,gamro,ama1,gama1
2526 + ,amk,amkz,amkst,gamkst
2528 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
2529 + ,ampiz,ampi,amro,gamro,ama1,gama1
2530 + ,amk,amkz,amkst,gamkst
2531 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
2532 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
2533 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
2534 REAL*4 gampmc ,gamper
2535 COMMON / taukle / bra1,brk0,brk0b,brks
2536 REAL*4 bra1,brk0,brk0b,brks
2537 COMMON / inout / inut,iout
2539 REAL hv(4),pks(4),pnu(4),pkk(4),ppi(4)
2540 REAL pdum1(4),pdum2(4),pdum3(4),pdum4(4)
2541 REAL*4 rrr(3),rtemp(1)
2543 DATA pi /3.141592653589793238462643/
2558 CALL
dphsks(wt,hv,pdum1,pdum2,pdum3,pdum4,jkst)
2559 IF(wt.GT.wtmax/1.2) wtmax=wt*1.2
2564 ELSEIF(mode.EQ. 0)
THEN
2566 IF(iwarm.EQ.0) goto 40
2574 IF(rmod.LT.dec1)
THEN
2579 CALL
dphsks(wt,hv,pnu,pks,pkk,ppi,jkst)
2582 IF(wt.GT.wtmax) nevovr=nevovr+1
2586 IF(rn*wtmax.GT.wt) goto 20
2588 costhe=-1.+2.*rrr(2)
2591 CALL
rotor2(thet,pnu,pnu)
2593 CALL
rotor2(thet,pks,pks)
2595 CALL
rotor2(thet,pkk,pkk)
2597 CALL
rotor2(thet,ppi,ppi)
2602 30 hhv(i)=-isgn*hv(i)
2605 ELSEIF(mode.EQ. 1)
THEN
2607 IF(nevraw.EQ.0)
RETURN
2608 pargam=swt/float(nevraw+1)
2610 IF(nevraw.NE.0) error=
sqrt(sswt/swt**2-1./float(nevraw))
2612 WRITE(iout, 10100) nevraw,nevacc,nevovr,pargam,rat,error
2620 10000
FORMAT(///1
x,15(5h*****)
2621 + /,
' *', 25
x,
'******** DADMKS INITIALISATION ********',9
x,1h*
2622 + /,
' *',e20.5,5
x,
'WTMAX = MAXIMUM WEIGHT ',9
x,1h*
2623 + /,1
x,15(5h*****)/)
2624 10100
FORMAT(///1
x,15(5h*****)
2625 + /,
' *', 25
x,
'******** DADMKS FINAL REPORT ********',9
x,1h*
2626 + /,
' *',i20 ,5
x,
'NEVRAW = NO. OF K* DECAYS TOTAL ',9
x,1h*,
2627 + /,
' *',i20 ,5
x,
'NEVACC = NO. OF K* DECS. ACCEPTED ',9
x,1h*,
2628 + /,
' *',i20 ,5
x,
'NEVOVR = NO. OF OVERWEIGHTED EVENTS ',9
x,1h*
2629 + /,
' *',e20.5,5
x,
'PARTIAL WTDTH (K* DECAY) IN GEV UNITS ',9
x,1h*,
2630 + /,
' *',f20.9,5
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',9
x,1h*
2631 + /,
' *',f20.8,5
x,
'RELATIVE ERROR OF PARTIAL WIDTH ',9
x,1h*
2632 + /,1
x,15(5h*****)/)
2633 40
WRITE(iout, 10200)
2634 10200
FORMAT(
' ----- DADMKS: LACK OF INITIALISATION')
2641 SUBROUTINE dadmmu(MODE,ISGN,HHV,PNU,PWB,Q1,Q2,PHX)
2643 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
2644 + ,ampiz,ampi,amro,gamro,ama1,gama1
2645 + ,amk,amkz,amkst,gamkst
2647 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
2648 + ,ampiz,ampi,amro,gamro,ama1,gama1
2649 + ,amk,amkz,amkst,gamkst
2650 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
2651 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
2652 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
2653 REAL*4 gampmc ,gamper
2654 COMMON / inout / inut,iout
2656 REAL hhv(4),hv(4),pnu(4),pwb(4),q1(4),q2(4)
2657 REAL pdum1(4),pdum2(4),pdum3(4),pdum4(4),pdum5(4)
2660 DATA pi /3.141592653589793238462643/
2673 CALL
dphsmu(wt,hv,pdum1,pdum2,pdum3,pdum4,pdum5)
2674 IF(wt.GT.wtmax/1.2) wtmax=wt*1.2
2678 ELSEIF(mode.EQ. 0)
THEN
2681 IF(iwarm.EQ.0) goto 40
2683 CALL
dphsmu(wt,hv,pnu,pwb,q1,q2,phx)
2689 IF(wt.GT.wtmax) nevovr=nevovr+1
2690 IF(rn*wtmax.GT.wt) goto 20
2692 costhe=-1.+2.*rrr(2)
2695 CALL
rotor2(thet,pnu,pnu)
2697 CALL
rotor2(thet,pwb,pwb)
2705 CALL
rotor2(thet,phx,phx)
2708 30 hhv(i)=-isgn*hv(i)
2711 ELSEIF(mode.EQ. 1)
THEN
2713 IF(nevraw.EQ.0)
RETURN
2714 pargam=swt/float(nevraw+1)
2716 IF(nevraw.NE.0) error=
sqrt(sswt/swt**2-1./float(nevraw))
2718 WRITE(iout, 10000) nevraw,nevacc,nevovr,pargam,rat,error
2726 10000
FORMAT(///1
x,15(5h*****)
2727 + /,
' *', 25
x,
'******** DADMMU FINAL REPORT ******** ',9
x,1h*
2728 + /,
' *',i20 ,5
x,
'NEVRAW = NO. OF MU DECAYS TOTAL ',9
x,1h*
2729 + /,
' *',i20 ,5
x,
'NEVACC = NO. OF MU DECS. ACCEPTED ',9
x,1h*
2730 + /,
' *',i20 ,5
x,
'NEVOVR = NO. OF OVERWEIGHTED EVENTS ',9
x,1h*
2731 + /,
' *',e20.5,5
x,
'PARTIAL WTDTH (MU DECAY) IN GEV UNITS ',9
x,1h*
2732 + /,
' *',f20.9,5
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',9
x,1h*
2733 + /,
' *',f20.9,5
x,
'RELATIVE ERROR OF PARTIAL WIDTH ',9
x,1h*
2734 + /,
' *',25
x,
'COMPLETE QED CORRECTIONS INCLUDED ',9
x,1h*
2735 + /,
' *',25
x,
'BUT ONLY V-A CUPLINGS ',9
x,1h*
2736 + /,1
x,15(5h*****)/)
2737 40
WRITE(iout, 10100)
2738 10100
FORMAT(
' ----- DADMMU: LACK OF INITIALISATION')
2744 SUBROUTINE dadmpi(MODE,ISGN,HV,PPI,PNU)
2746 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
2747 * ,ampiz,ampi,amro,gamro,ama1,gama1
2748 * ,amk,amkz,amkst,gamkst
2750 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
2751 * ,ampiz,ampi,amro,gamro,ama1,gama1
2752 * ,amk,amkz,amkst,gamkst
2753 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
2754 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
2755 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
2756 REAL*4 gampmc ,gamper
2757 COMMON / inout / inut,iout
2758 REAL ppi(4),pnu(4),hv(4)
2759 DATA pi /3.141592653589793238462643/
2764 ELSEIF(mode.EQ. 0)
THEN
2767 epi= (amtau**2+ampi**2-amnuta**2)/(2*amtau)
2768 enu= (amtau**2-ampi**2+amnuta**2)/(2*amtau)
2769 xpi=
sqrt(epi**2-ampi**2)
2779 qxn=ppi(4)*pnu(4)-ppi(1)*pnu(1)-ppi(2)*pnu(2)-ppi(3)*pnu(3)
2780 brak=(gv**2+ga**2)*(2*pxq*qxn-ampi**2*pxn)
2781 & +(gv**2-ga**2)*amtau*amnuta*ampi**2
2783 20 hv(i)=-isgn*2*ga*gv*amtau*(2*ppi(i)*qxn-pnu(i)*ampi**2)/brak
2786 ELSEIF(mode.EQ. 1)
THEN
2788 IF(nevtot.EQ.0)
RETURN
2794 gamm=(gfermi*fpi)**2/(16.*pi)*amtau**3*
2796 $
sqrt((amtau**2-ampi**2-amnuta**2)**2
2797 $ -4*ampi**2*amnuta**2 )/amtau**2
2800 WRITE(iout, 10000) nevtot,gamm,rat,error
2807 10000
FORMAT(///1
x,15(5h*****)
2808 $ /,
' *', 25
x,
'******** DADMPI FINAL REPORT ******** ',9
x,1h*
2809 $ /,
' *',i20 ,5
x,
'NEVTOT = NO. OF PI DECAYS TOTAL ',9
x,1h*
2810 $ /,
' *',e20.5,5
x,
'PARTIAL WTDTH ( PI DECAY) IN GEV UNITS ',9
x,1h*
2811 $ /,
' *',f20.9,5
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',9
x,1h*
2812 $ /,
' *',f20.8,5
x,
'RELATIVE ERROR OF PARTIAL WIDTH (STAT.)',9
x,1h*
2813 $ /,1
x,15(5h*****)/)
2819 SUBROUTINE dadmro(MODE,ISGN,HHV,PNU,PRO,PIC,PIZ)
2821 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
2822 + ,ampiz,ampi,amro,gamro,ama1,gama1
2823 + ,amk,amkz,amkst,gamkst
2825 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
2826 + ,ampiz,ampi,amro,gamro,ama1,gama1
2827 + ,amk,amkz,amkst,gamkst
2828 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
2829 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
2830 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
2831 REAL*4 gampmc ,gamper
2832 COMMON / inout / inut,iout
2834 REAL hv(4),pro(4),pnu(4),pic(4),piz(4)
2835 REAL pdum1(4),pdum2(4),pdum3(4),pdum4(4)
2838 DATA pi /3.141592653589793238462643/
2851 CALL
dphsro(wt,hv,pdum1,pdum2,pdum3,pdum4)
2852 IF(wt.GT.wtmax/1.2) wtmax=wt*1.2
2857 ELSEIF(mode.EQ. 0)
THEN
2860 IF(iwarm.EQ.0) goto 40
2861 CALL
dphsro(wt,hv,pnu,pro,pic,piz)
2868 IF(wt.GT.wtmax) nevovr=nevovr+1
2869 IF(rn*wtmax.GT.wt) goto 20
2871 costhe=-1.+2.*rrr(2)
2874 CALL
rotor2(thet,pnu,pnu)
2876 CALL
rotor2(thet,pro,pro)
2878 CALL
rotor2(thet,pic,pic)
2880 CALL
rotor2(thet,piz,piz)
2885 30 hhv(i)=-isgn*hv(i)
2888 ELSEIF(mode.EQ. 1)
THEN
2890 IF(nevraw.EQ.0)
RETURN
2891 pargam=swt/float(nevraw+1)
2893 IF(nevraw.NE.0) error=
sqrt(sswt/swt**2-1./float(nevraw))
2895 WRITE(iout, 10100) nevraw,nevacc,nevovr,pargam,rat,error
2903 10000
FORMAT(///1
x,15(5h*****)
2904 + /,
' *', 25
x,
'******** DADMRO INITIALISATION ********',9
x,1h*
2905 + /,
' *',e20.5,5
x,
'WTMAX = MAXIMUM WEIGHT ',9
x,1h*
2906 + /,1
x,15(5h*****)/)
2907 10100
FORMAT(///1
x,15(5h*****)
2908 + /,
' *', 25
x,
'******** DADMRO FINAL REPORT ******** ',9
x,1h*
2909 + /,
' *',i20 ,5
x,
'NEVRAW = NO. OF RHO DECAYS TOTAL ',9
x,1h*
2910 + /,
' *',i20 ,5
x,
'NEVACC = NO. OF RHO DECS. ACCEPTED ',9
x,1h*
2911 + /,
' *',i20 ,5
x,
'NEVOVR = NO. OF OVERWEIGHTED EVENTS ',9
x,1h*
2912 + /,
' *',e20.5,5
x,
'PARTIAL WTDTH (RHO DECAY) IN GEV UNITS ',9
x,1h*
2913 + /,
' *',f20.9,5
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',9
x,1h*
2914 + /,
' *',f20.8,5
x,
'RELATIVE ERROR OF PARTIAL WIDTH ',9
x,1h*
2915 + /,1
x,15(5h*****)/)
2916 40
WRITE(iout, 10200)
2917 10200
FORMAT(
' ----- DADMRO: LACK OF INITIALISATION')
2925 SUBROUTINE dadnew(MODE,ISGN,HV,PNU,PWB,PNPI,JNPI)
2927 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
2928 + ,ampiz,ampi,amro,gamro,ama1,gama1
2929 + ,amk,amkz,amkst,gamkst
2931 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
2932 + ,ampiz,ampi,amro,gamro,ama1,gama1
2933 + ,amk,amkz,amkst,gamkst
2934 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
2935 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
2936 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
2937 REAL*4 gampmc ,gamper
2938 COMMON / inout / inut,iout
2939 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
2940 COMMON / mdecomp /idffin(9,nmode),mulpik(nmode)
2942 CHARACTER names(nmode)*31
2944 REAL*4 pnu(4),pwb(4),pnpi(4,9),hv(4),hhv(4)
2945 REAL*4 pdum1(4),pdum2(4),pdumi(4,9)
2948 REAL*8 swt(nmode),sswt(nmode)
2949 dimension nevraw(nmode),nevovr(nmode),nevacc(nmode)
2951 DATA pi /3.141592653589793238462643/
2970 ELSEIF(jnpi.LE.nm4)
THEN
2971 CALL
dph4pi(wt,hv,pdum1,pdum2,pdumi,jnpi)
2972 ELSEIF(jnpi.LE.nm4+nm5)
THEN
2973 CALL
dph5pi(wt,hv,pdum1,pdum2,pdumi,jnpi)
2974 ELSEIF(jnpi.LE.nm4+nm5+nm6)
THEN
2975 CALL
dphnpi(wt,hv,pdum1,pdum2,pdumi,jnpi)
2976 ELSEIF(jnpi.LE.nm4+nm5+nm6+nm3)
THEN
2977 inum=jnpi-nm4-nm5-nm6
2978 CALL
dphspk(wt,hv,pdum1,pdum2,pdumi,inum)
2979 ELSEIF(jnpi.LE.nm4+nm5+nm6+nm3+nm2)
THEN
2980 inum=jnpi-nm4-nm5-nm6-nm3
2981 CALL
dphsrk(wt,hv,pdum1,pdum2,pdumi,inum)
2985 IF(wt.GT.wtmax(jnpi)/1.2) wtmax(jnpi)=wt*1.2
2992 ELSEIF(mode.EQ. 0)
THEN
2994 IF(iwarm.EQ.0) goto 50
2999 ELSEIF(jnpi.LE.nm4)
THEN
3000 CALL
dph4pi(wt,hhv,pnu,pwb,pnpi,jnpi)
3001 ELSEIF(jnpi.LE.nm4+nm5)
THEN
3002 CALL
dph5pi(wt,hhv,pnu,pwb,pnpi,jnpi)
3003 ELSEIF(jnpi.LE.nm4+nm5+nm6)
THEN
3004 CALL
dphnpi(wt,hhv,pnu,pwb,pnpi,jnpi)
3005 ELSEIF(jnpi.LE.nm4+nm5+nm6+nm3)
THEN
3006 inum=jnpi-nm4-nm5-nm6
3007 CALL
dphspk(wt,hhv,pnu,pwb,pnpi,inum)
3008 ELSEIF(jnpi.LE.nm4+nm5+nm6+nm3+nm2)
THEN
3009 inum=jnpi-nm4-nm5-nm6-nm3
3010 CALL
dphsrk(wt,hhv,pnu,pwb,pnpi,inum)
3018 nevraw(jnpi)=nevraw(jnpi)+1
3019 swt(jnpi)=swt(jnpi)+wt
3020 sswt(jnpi)=sswt(jnpi)+wt**2
3023 IF(wt.GT.wtmax(jnpi)) nevovr(jnpi)=nevovr(jnpi)+1
3024 IF(rn*wtmax(jnpi).GT.wt) goto 20
3026 costhe=-1.+2.*rrr(2)
3029 CALL
rotor2(thet,pnu,pnu)
3031 CALL
rotor2(thet,pwb,pwb)
3037 CALL
rotor2(thet,pnpi(1,i),pnpi(1,i))
3040 nevacc(jnpi)=nevacc(jnpi)+1
3042 ELSEIF(mode.EQ. 1)
THEN
3045 IF(nevraw(jnpi).EQ.0) goto 40
3046 pargam=swt(jnpi)/float(nevraw(jnpi)+1)
3048 IF(nevraw(jnpi).NE.0)
3049 + error=
sqrt(sswt(jnpi)/swt(jnpi)**2-1./float(nevraw(jnpi)))
3051 WRITE(iout, 10300) names(jnpi), nevraw(jnpi),nevacc(jnpi),
3052 + nevovr(jnpi),pargam,rat,error
3054 gampmc(8+jnpi-1)=rat
3055 gamper(8+jnpi-1)=error
3061 10000
FORMAT(///1
x,15(5h*****)
3062 + /,
' *', 25
x,
'******** DADNEW INITIALISATION ********',9
x,1h*
3064 10100
FORMAT(
' *',e20.5,5
x,
'WTMAX = MAXIMUM WEIGHT ',9
x,1h*/)
3066 + /,1
x,15(5h*****)/)
3067 10300
FORMAT(///1
x,15(5h*****)
3068 + /,
' *', 25
x,
'******** DADNEW FINAL REPORT ******** ',9
x,1h*
3069 + /,
' *', 25
x,
'CHANNEL:',a31 ,9
x,1h*
3070 + /,
' *',i20 ,5
x,
'NEVRAW = NO. OF DECAYS TOTAL ',9
x,1h*
3071 + /,
' *',i20 ,5
x,
'NEVACC = NO. OF DECAYS ACCEPTED ',9
x,1h*
3072 + /,
' *',i20 ,5
x,
'NEVOVR = NO. OF OVERWEIGHTED EVENTS ',9
x,1h*
3073 + /,
' *',e20.5,5
x,
'PARTIAL WTDTH IN GEV UNITS ',9
x,1h*
3074 + /,
' *',f20.9,5
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',9
x,1h*
3075 + /,
' *',f20.8,5
x,
'RELATIVE ERROR OF PARTIAL WIDTH ',9
x,1h*
3076 + /,1
x,15(5h*****)/)
3077 50
WRITE(iout, 10400)
3078 10400
FORMAT(
' ----- DADNEW: LACK OF INITIALISATION')
3080 60
WRITE(iout, 10500) jnpi,mode
3081 10500
FORMAT(
' ----- DADNEW: WRONG JNPI',2i5)
3088 SUBROUTINE dam4pi(MNUM,PT,PN,PIM1,PIM2,PIM3,PIM4,AMPLIT,HV)
3098 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
3099 + ,ampiz,ampi,amro,gamro,ama1,gama1
3100 + ,amk,amkz,amkst,gamkst
3102 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
3103 + ,ampiz,ampi,amro,gamro,ama1,gama1
3104 + ,amk,amkz,amkst,gamkst
3105 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
3106 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
3107 REAL hv(4),
pt(4),pn(4),pim1(4),pim2(4),pim3(4),pim4(4)
3108 REAL pivec(4),piaks(4),hvm(4)
3111 DATA pi /3.141592653589793238462643/
3114 CALL
curr(mnum,pim1,pim2,pim3,pim4,hadcur)
3117 CALL
clvec(hadcur,pn,pivec)
3118 CALL
claxi(hadcur,pn,piaks)
3119 CALL
clnut(hadcur,brakm,hvm)
3121 brak= (gv**2+ga**2)*
pt(4)*pivec(4) +2.*gv*ga*
pt(4)*piaks(4)
3122 + +2.*(gv**2-ga**2)*amnuta*amtau*brakm
3123 amplit=(ccabib*gfermi)**2*brak/2.
3126 hv(i)=-(amtau*((gv**2+ga**2)*piaks(i)+2.*gv*ga*pivec(i)))
3127 + +(gv**2-ga**2)*amnuta*amtau*hvm(i)
3129 IF (brak.NE.0.0) hv(i)=-hv(i)/brak
3136 SUBROUTINE dampaa(PT,PN,PIM1,PIM2,PIPL,AMPLIT,HV)
3146 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
3147 + ,ampiz,ampi,amro,gamro,ama1,gama1
3148 + ,amk,amkz,amkst,gamkst
3150 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
3151 + ,ampiz,ampi,amro,gamro,ama1,gama1
3152 + ,amk,amkz,amkst,gamkst
3153 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
3154 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
3155 COMMON /testa1/ keya1
3156 REAL hv(4),
pt(4),pn(4),pim1(4),pim2(4),pipl(4)
3157 REAL paa(4),vec1(4),vec2(4)
3158 REAL pivec(4),piaks(4),hvm(4)
3159 COMPLEX bwign,hadcur(4),
fpik
3166 bwign(xm,am,
gamma)=1./cmplx(xm**2-am**2,
gamma*am)
3170 10 paa(i)=pim1(i)+pim2(i)+pipl(i)
3172 xmaa =
sqrt(abs(paa(4)**2-paa(3)**2-paa(2)**2-paa(1)**2))
3173 xmro1 =
sqrt(abs((pipl(4)+pim1(4))**2-(pipl(1)+pim1(1))**2
3174 + -(pipl(2)+pim1(2))**2-(pipl(3)+pim1(3))**2))
3175 xmro2 =
sqrt(abs((pipl(4)+pim2(4))**2-(pipl(1)+pim2(1))**2
3176 + -(pipl(2)+pim2(2))**2-(pipl(3)+pim2(3))**2))
3178 prod1 =paa(4)*(pim1(4)-pipl(4))-paa(1)*(pim1(1)-pipl(1))
3179 + -paa(2)*(pim1(2)-pipl(2))-paa(3)*(pim1(3)-pipl(3))
3180 prod2 =paa(4)*(pim2(4)-pipl(4))-paa(1)*(pim2(1)-pipl(1))
3181 + -paa(2)*(pim2(2)-pipl(2))-paa(3)*(pim2(3)-pipl(3))
3183 vec1(i)= pim1(i)-pipl(i) -paa(i)*prod1/xmaa**2
3184 20 vec2(i)= pim2(i)-pipl(i) -paa(i)*prod2/xmaa**2
3186 IF (keya1.EQ.1)
THEN
3190 fnorm=fa1/
sqrt(2.)*faropi*fro2pi
3192 hadcur(i)= cmplx(fnorm) *ama1**2*bwign(xmaa,ama1,gama1)
3193 + *(cmplx(vec1(i))*amro**2*bwign(xmro1,amro,gamro) +
3194 + cmplx(vec2(i))*amro**2*bwign(xmro2,amro,gamro))
3197 fnorm=2.0*
sqrt(2.)/3.0/fpi
3198 gamax=gama1*
gfun(xmaa**2)/
gfun(ama1**2)
3200 hadcur(i)= cmplx(fnorm) *ama1**2*bwign(xmaa,ama1,gamax)
3201 + *(cmplx(vec1(i))*
fpik(xmro1) +cmplx(vec2(i))*
fpik(xmro2))
3206 CALL
clvec(hadcur,pn,pivec)
3207 CALL
claxi(hadcur,pn,piaks)
3208 CALL
clnut(hadcur,brakm,hvm)
3210 brak= (gv**2+ga**2)*
pt(4)*pivec(4) +2.*gv*ga*
pt(4)*piaks(4)
3211 + +2.*(gv**2-ga**2)*amnuta*amtau*brakm
3212 amplit=(gfermi*ccabib)**2*brak/2.
3217 hv(i)=-(amtau*((gv**2+ga**2)*piaks(i)+2.*gv*ga*pivec(i)))
3218 + +(gv**2-ga**2)*amnuta*amtau*hvm(i)
3227 SUBROUTINE dampog(PT,PN,PIM1,PIM2,PIPL,AMPLIT,HV)
3237 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
3238 + ,ampiz,ampi,amro,gamro,ama1,gama1
3239 + ,amk,amkz,amkst,gamkst
3241 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
3242 + ,ampiz,ampi,amro,gamro,ama1,gama1
3243 + ,amk,amkz,amkst,gamkst
3244 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
3245 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
3246 COMMON /testa1/ keya1
3247 REAL hv(4),
pt(4),pn(4),pim1(4),pim2(4),pipl(4)
3248 REAL paa(4),vec1(4),vec2(4)
3249 REAL pivec(4),piaks(4),hvm(4)
3250 COMPLEX bwign,hadcur(4),fnorm,
formom
3253 bwign(xm,am,
gamma)=1./cmplx(xm**2-am**2,
gamma*am)
3260 10 paa(i)=pim1(i)+pim2(i)+pipl(i)
3263 xmaa =
sqrt(abs(paa(4)**2-paa(3)**2-paa(2)**2-paa(1)**2))
3264 xmom =
sqrt(abs( (pim2(4)+pipl(4))**2-(pim2(3)+pipl(3))**2
3265 + -(pim2(2)+pipl(2))**2-(pim2(1)+pipl(1))**2 ))
3266 xmro2 =(pipl(1))**2 +(pipl(2))**2 +(pipl(3))**2
3268 prod1 =vec1(1)*pipl(1)
3269 prod2 =vec2(2)*pipl(2)
3270 p12 =pim1(4)*pim2(4)-pim1(1)*pim2(1)
3271 + -pim1(2)*pim2(2)-pim1(3)*pim2(3)
3272 p1pl =pim1(4)*pipl(4)-pim1(1)*pipl(1)
3273 + -pim1(2)*pipl(2)-pim1(3)*pipl(3)
3274 p2pl =pipl(4)*pim2(4)-pipl(1)*pim2(1)
3275 + -pipl(2)*pim2(2)-pipl(3)*pim2(3)
3277 vec1(i)= (vec1(i)-prod1/xmro2*pipl(i))
3279 gnorm=
sqrt(vec1(1)**2+vec1(2)**2+vec1(3)**2)
3281 vec1(i)= vec1(i)/gnorm
3283 vec2(1)=(vec1(2)*pipl(3)-vec1(3)*pipl(2))/
sqrt(xmro2)
3284 vec2(2)=(vec1(3)*pipl(1)-vec1(1)*pipl(3))/
sqrt(xmro2)
3285 vec2(3)=(vec1(1)*pipl(2)-vec1(2)*pipl(1))/
sqrt(xmro2)
3286 p1vec1 =pim1(4)*vec1(4)-pim1(1)*vec1(1)
3287 + -pim1(2)*vec1(2)-pim1(3)*vec1(3)
3288 p2vec1 =vec1(4)*pim2(4)-vec1(1)*pim2(1)
3289 + -vec1(2)*pim2(2)-vec1(3)*pim2(3)
3290 p1vec2 =pim1(4)*vec2(4)-pim1(1)*vec2(1)
3291 + -pim1(2)*vec2(2)-pim1(3)*vec2(3)
3292 p2vec2 =vec2(4)*pim2(4)-vec2(1)*pim2(1)
3293 + -vec2(2)*pim2(2)-vec2(3)*pim2(3)
3300 hadcur(i) = fnorm *( vec1(i)*(ampi**2*p1pl-p2pl*(p12-p1pl))
3301 + -pim2(i)*(p2vec1*p1pl-p1vec1*p2pl) +pipl(i)*(p2vec1*p12 -
3302 + p1vec1*(ampi**2+p2pl)) )
3304 hadcur(i) = fnorm *( vec2(i)*(ampi**2*p1pl-p2pl*(p12-p1pl))
3305 + -pim2(i)*(p2vec2*p1pl-p1vec2*p2pl) +pipl(i)*(p2vec2*p12 -
3306 + p1vec2*(ampi**2+p2pl)) )
3311 CALL
clvec(hadcur,pn,pivec)
3312 CALL
claxi(hadcur,pn,piaks)
3313 CALL
clnut(hadcur,brakm,hvm)
3315 brak=brak+(gv**2+ga**2)*
pt(4)*pivec(4) +2.*gv*ga*
pt(4)*piaks(4)
3316 + +2.*(gv**2-ga**2)*amnuta*amtau*brakm
3318 hv(i)=hv(i)-(amtau*((gv**2+ga**2)*piaks(i)+2.*gv*ga*pivec(i))
3319 + ) +(gv**2-ga**2)*amnuta*amtau*hvm(i)
3323 amplit=(gfermi*ccabib)**2*brak/2.
3336 SUBROUTINE damppk(MNUM,PT,PN,PIM1,PIM2,PIM3,AMPLIT,HV)
3346 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
3347 + ,ampiz,ampi,amro,gamro,ama1,gama1
3348 + ,amk,amkz,amkst,gamkst
3350 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
3351 + ,ampiz,ampi,amro,gamro,ama1,gama1
3352 + ,amk,amkz,amkst,gamkst
3353 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
3354 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
3355 REAL hv(4),
pt(4),pn(4),pim1(4),pim2(4),pim3(4)
3356 REAL paa(4),vec1(4),vec2(4),vec3(4),vec4(4),vec5(4)
3357 REAL pivec(4),piaks(4),hvm(4)
3358 REAL fnorm(0:7),coef(1:5,0:7)
3361 DATA pi /3.141592653589793238462643/
3365 IF (icont.EQ.0)
THEN
3373 fnorm(4)=scabib/fpi/dwapi0
3378 coef(1,0)= 2.0*
sqrt(2.)/3.0
3379 coef(2,0)=-2.0*
sqrt(2.)/3.0
3384 coef(1,1)=-
sqrt(2.)/3.0
3385 coef(2,1)=
sqrt(2.)/3.0
3390 coef(1,2)=-
sqrt(2.)/3.0
3391 coef(2,2)=
sqrt(2.)/3.0
3402 coef(1,4)= 1.0/
sqrt(2.)/3.0
3403 coef(2,4)=-1.0/
sqrt(2.)/3.0
3408 coef(1,5)=-
sqrt(2.)/3.0
3409 coef(2,5)=
sqrt(2.)/3.0
3424 coef(5,7)=-
sqrt(2.0/3.0)
3429 10 paa(i)=pim1(i)+pim2(i)+pim3(i)
3430 xmaa =
sqrt(abs(paa(4)**2-paa(3)**2-paa(2)**2-paa(1)**2))
3431 xmro1 =
sqrt(abs((pim3(4)+pim2(4))**2-(pim3(1)+pim2(1))**2
3432 + -(pim3(2)+pim2(2))**2-(pim3(3)+pim2(3))**2))
3433 xmro2 =
sqrt(abs((pim3(4)+pim1(4))**2-(pim3(1)+pim1(1))**2
3434 + -(pim3(2)+pim1(2))**2-(pim3(3)+pim1(3))**2))
3435 xmro3 =
sqrt(abs((pim1(4)+pim2(4))**2-(pim1(1)+pim2(1))**2
3436 + -(pim1(2)+pim2(2))**2-(pim1(3)+pim2(3))**2))
3438 prod1 =paa(4)*(pim2(4)-pim3(4))-paa(1)*(pim2(1)-pim3(1))
3439 + -paa(2)*(pim2(2)-pim3(2))-paa(3)*(pim2(3)-pim3(3))
3440 prod2 =paa(4)*(pim3(4)-pim1(4))-paa(1)*(pim3(1)-pim1(1))
3441 + -paa(2)*(pim3(2)-pim1(2))-paa(3)*(pim3(3)-pim1(3))
3442 prod3 =paa(4)*(pim1(4)-pim2(4))-paa(1)*(pim1(1)-pim2(1))
3443 + -paa(2)*(pim1(2)-pim2(2))-paa(3)*(pim1(3)-pim2(3))
3445 vec1(i)= pim2(i)-pim3(i) -paa(i)*prod1/xmaa**2
3446 vec2(i)= pim3(i)-pim1(i) -paa(i)*prod2/xmaa**2
3447 vec3(i)= pim1(i)-pim2(i) -paa(i)*prod3/xmaa**2
3448 20 vec4(i)= pim1(i)+pim2(i)+pim3(i)
3449 CALL
prod5(pim1,pim2,pim3,vec5)
3453 hadcur(i)= cmplx(fnorm(mnum)) * ( cmplx(vec1(i)*coef(1,mnum))*
3454 +
form1(mnum,xmaa**2,xmro1**2,xmro2**2)+cmplx(vec2(i)*coef(2,
3455 + mnum))*
form2(mnum,xmaa**2,xmro2**2,xmro1**2)+cmplx(vec3(i)*
3456 + coef(3,mnum))*
form3(mnum,xmaa**2,xmro3**2,xmro1**2)+(-1.0*uroj)
3457 + * cmplx(vec4(i)*coef(4,mnum))*
form4(mnum,xmaa**2,xmro1**2,
3458 + xmro2**2,xmro3**2) +(-1.0)*uroj/4.0/pi**2/fpi**2* cmplx(vec5(i)
3459 + *coef(5,mnum))*
form5(mnum,xmaa**2,xmro1**2,xmro2**2))
3463 CALL
clvec(hadcur,pn,pivec)
3464 CALL
claxi(hadcur,pn,piaks)
3465 CALL
clnut(hadcur,brakm,hvm)
3467 brak= (gv**2+ga**2)*
pt(4)*pivec(4) +2.*gv*ga*
pt(4)*piaks(4)
3468 + +2.*(gv**2-ga**2)*amnuta*amtau*brakm
3469 amplit=(gfermi)**2*brak/2.
3471 print *,
'MNUM=',mnum
3477 IF (k.EQ.4) znak=1.0
3478 xm1=znak*pim1(k)**2+xm1
3479 xm2=znak*pim2(k)**2+xm2
3480 xm3=znak*pim3(k)**2+xm3
3481 40
print *,
'PIM1=',pim1(k),
'PIM2=',pim2(k),
'PIM3=',pim3(k)
3483 print *,
'************************************************'
3487 hv(i)=-(amtau*((gv**2+ga**2)*piaks(i)+2.*gv*ga*pivec(i)))
3488 + +(gv**2-ga**2)*amnuta*amtau*hvm(i)
3495 SUBROUTINE dampry(ITDKRC,XK0DEC,XK,XA,QP,XN,AMPLIT,HV)
3496 IMPLICIT REAL*8 (
a-h,o-
z)
3502 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
3503 * ,ampiz,ampi,amro,gamro,ama1,gama1
3504 * ,amk,amkz,amkst,gamkst
3506 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
3507 * ,ampiz,ampi,amro,gamro,ama1,gama1
3508 * ,amk,amkz,amkst,gamkst
3509 REAL*8 hv(4),qp(4),xn(4),xa(4),xk(4)
3513 IF(xk(4).LT.0.1d0*ak0)
THEN
3514 amplit=
thb(itdkrc,qp,xn,xa,ak0,hv)
3516 amplit=
sqm2(itdkrc,qp,xn,xa,xk,ak0,hv)
3523 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
3524 * ,ampiz,ampi,amro,gamro,ama1,gama1
3525 * ,amk,amkz,amkst,gamkst
3527 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
3528 * ,ampiz,ampi,amro,gamro,ama1,gama1
3529 * ,amk,amkz,amkst,gamkst
3530 IF (
ident.EQ. 1)
THEN
3532 ELSEIF (
ident.EQ.-1)
THEN
3534 ELSEIF (
ident.EQ. 2)
THEN
3536 ELSEIF (
ident.EQ.-2)
THEN
3538 ELSEIF (
ident.EQ. 3)
THEN
3540 ELSEIF (
ident.EQ.-3)
THEN
3542 ELSEIF (
ident.EQ. 4)
THEN
3544 ELSEIF (
ident.EQ.-4)
THEN
3546 ELSEIF (
ident.EQ. 8)
THEN
3548 ELSEIF (
ident.EQ.-8)
THEN
3550 ELSEIF (
ident.EQ. 9)
THEN
3552 ELSEIF (
ident.EQ.-9)
THEN
3555 print *,
'STOP IN APKMAS, WRONG IDENT=',
ident
3572 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
3573 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
3574 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
3575 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
3576 COMMON /loptim/ optx(4),opty(4),optq2(4),optw2(4),comfac
3577 COMMON /linteg/ ntot,npass
3578 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
3579 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
3591 IF(lst(31).EQ.1)
THEN
3594 w2=(1.-
x)*
y*parl(21)+psave(3,2,5)**2
3595 ELSEIF(lst(31).EQ.2)
THEN
3598 w2=(1.-
x)*
y*parl(21)+psave(3,2,5)**2
3599 ELSEIF(lst(31).EQ.3)
THEN
3601 y=(w2-psave(3,2,5)**2)/((1.-
x)*parl(21))
3604 q2low=max(q2min,
x*ymin*
s,(w2min-pm2)*
x/(1.-
x))
3605 q2upp=min(q2max,
x*ymax*
s,(w2max-pm2)*
x/(1.-
x))
3606 ylow=max(ymin,q2min/(
s*
x),(w2min-pm2)/(
s*(1.-
x)))
3607 yupp=min(ymax,q2max/(
s*
x),(w2max-pm2)/(
s*(1.-
x)))
3608 w2low=max(w2min,(1.-
x)*ymin*
s+pm2,q2min*(1.-
x)/
x+pm2)
3609 w2upp=min(w2max,(1.-
x)*ymax*
s+pm2,q2max*(1.-
x)/
x+pm2)
3610 IF(q2.LT.q2low.OR.q2.GT.q2upp)
RETURN
3611 IF(
y.LT.ylow.OR.
y.GT.yupp)
RETURN
3612 IF(w2.LT.w2low.OR.w2.GT.w2upp)
RETURN
3619 IF(lst(21).NE.0)
RETURN
3621 dcross=pari(31)*pq(17)*comfac
3634 common/cfread/space(5000)
3635 common/mykeys/ievar,if5cc,ineut,iinte,iferm,iflat,icoun,
3636 & refix,imudo,ikat1,ikat2,ikat3,ikat4,ikat5,ikat6,
3637 & inevt,ijak1,ijak2,iitdk,rptau,rxk0d,ntgr,idimuon,iglu,
3638 & iqden,lome(2),ifiles,iccha,iseed,idsubs,ionem,ehac,ipsel,
3644 DOUBLE PRECISION hh(4)
3646 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
3647 COMMON / idfc / idff
3649 COMMON / inout / inut,iout
3651 COMMON / idpart / ia1
3654 COMMON / taurad / xk0dec,itdkrc
3656 COMMON /testa1/ keya1
3676 IF (ktory.EQ.1)
THEN
3702 WRITE(nout,
'(6A6/6I6)')
3703 +
'KAT1',
'KAT2',
'KAT3',
'KAT4',
'KAT5',
'KAT6',
3704 + kat1 , kat2 , kat3 , kat4 , kat5 , kat6
3705 WRITE(nout,
'(4A12/4I12)')
3706 +
'NEVT',
'JAK1',
'JAK2',
'ITDKRC',
3707 + nevt, jak1 , jak2 , itdkrc
3708 WRITE(nout,
'(2A12/2F12.6)')
3716 IF (ktory.EQ.1)
THEN
3728 print *,
'FOR THE SAKE OF THESE TESTS KTO HAS TO BE 2'
3729 print *,
'TO CHANGE TAU- TO TAU+ CHANGE IDFF FROM -15 TO 15'
3741 print *,
'NEVTES= ',nevtes
3742 WRITE(iout,10800) keya1
3744 IF (ktory.EQ.1)
THEN
3745 WRITE(iout,10400) jak,idff,pol(3),ptau
3747 WRITE(iout,10700) jak,idff,pol(3),ptau
3756 IF (ktory.EQ.1)
THEN
3763 10400
FORMAT(//4(/1
x,15(5h=====))
3764 + /,
' ', 19
x,
' TEST OF RAD. CORR IN ELECTRON DECAY ',9
x,1h ,
3765 + /,
' ', 19
x,
' TESTS OF TAU DECAY ROUTINES ',9
x,1h ,
3766 + /,
' ', 19
x,
' INTERFACE OF THE KORAL-Z TYPE ',9
x,1h ,
3767 + 2(/,1
x,15(5h=====)),
3768 + /,5
x ,
'JAK =',i7 ,
' KEY DEFINING DECAY TYPE ',9
x,1h ,
3769 + /,5
x ,
'IDFF =',i7 ,
' LUND IDENTIFIER FOR FIRST TAU ',9
x,1h ,
3770 + /,5
x ,
'POL(3)=',f7.2,
' THIRD COMPONENT OF TAU POLARIZ. ',9
x,1h ,
3771 + /,5
x ,
'PTAU =',f7.2,
' THIRD COMPONENT OF TAU MOM. GEV ',9
x,1h ,
3772 + 2(/,1
x,15(5h=====))/)
3773 10500
FORMAT(///1
x,
'===== EVENT NO.',i4,1
x,5h=====)
3774 10600
FORMAT(5
x,
'POLARIMETRIC VECTOR: ',
3775 + 7
x,
'HH(1)',7
x,
'HH(2)',7
x,
'HH(3)',7
x,
'HH(4)',
3776 + /, 5
x,
' ', 4(1
x,f11.8) )
3777 10700
FORMAT(//4(/1
x,15(5h=====))
3778 + /,
' ', 19
x,
' TEST OF RAD. CORR IN ELECTRON DECAY ',9
x,1h ,
3779 + /,
' ', 19
x,
' TESTS OF TAU DECAY ROUTINES ',9
x,1h ,
3780 + /,
' ', 19
x,
' INTERFACE OF THE KORAL-B TYPE ',9
x,1h ,
3781 + 2(/,1
x,15(5h=====)),
3782 + /,5
x ,
'JAK =',i7 ,
' KEY DEFINING DECAY TYPE ',9
x,1h ,
3783 + /,5
x ,
'IDFF =',i7 ,
' LUND IDENTIFIER FOR FIRST TAU ',9
x,1h ,
3784 + /,5
x ,
'POL(3)=',f7.2,
' THIRD COMPONENT OF TAU POLARIZ. ',9
x,1h ,
3785 + /,5
x ,
'PTAU =',f7.2,
' THIRD COMPONENT OF TAU MOM. GEV ',9
x,1h ,
3786 + 2(/,1
x,15(5h=====))/)
3787 10800
FORMAT(///1
x,
'===== TYPE OF CURRENT',i4,1
x,5h=====)
3794 SUBROUTINE dekay(KTO,HX)
3819 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
3821 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
3822 REAL*4 gampmc ,gamper
3823 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
3824 COMMON / mdecomp /idffin(9,nmode),mulpik(nmode)
3826 CHARACTER names(nmode)*31
3827 COMMON / inout / inut,iout
3828 REAL pdum1(4),pdum2(4),pdum3(4),pdum4(4),pdum5(4),hdum(4)
3836 IF (iwarm.EQ.1)
x=5/(iwarm-1)
3838 WRITE(iout,10000) jak1,jak2
3842 IF(jak1.NE.-1.OR.jak2.NE.-1)
THEN
3843 CALL
dadmel(-1,idum,hdum,pdum1,pdum2,pdum3,pdum4,pdum5)
3844 CALL
dadmmu(-1,idum,hdum,pdum1,pdum2,pdum3,pdum4,pdum5)
3845 CALL
dadmpi(-1,idum,pdum,pdum1,pdum2)
3846 CALL
dadmro(-1,idum,hdum,pdum1,pdum2,pdum3,pdum4)
3847 CALL
dadmaa(-1,idum,hdum,pdum1,pdum2,pdum3,pdum4,pdum5,jdum)
3848 CALL
dadmkk(-1,idum,pdum,pdum1,pdum2)
3849 CALL
dadmks(-1,idum,hdum,pdum1,pdum2,pdum3,pdum4,jdum)
3850 CALL
dadnew(-1,idum,hdum,pdum1,pdum2,pdumx,jdum)
3856 ELSEIF(kto.EQ.1)
THEN
3860 IF(iwarm.EQ.0) goto 30
3863 ELSEIF(kto.EQ.2)
THEN
3867 IF(iwarm.EQ.0) goto 30
3870 ELSEIF(kto.EQ.11)
THEN
3876 ELSEIF(kto.EQ.12)
THEN
3882 ELSEIF(kto.EQ.100)
THEN
3884 IF(jak1.NE.-1.OR.jak2.NE.-1)
THEN
3885 CALL
dadmel( 1,idum,hdum,pdum1,pdum2,pdum3,pdum4,pdum5)
3886 CALL
dadmmu( 1,idum,hdum,pdum1,pdum2,pdum3,pdum4,pdum5)
3887 CALL
dadmpi( 1,idum,pdum,pdum1,pdum2)
3888 CALL
dadmro( 1,idum,hdum,pdum1,pdum2,pdum3,pdum4)
3889 CALL
dadmaa( 1,idum,hdum,pdum1,pdum2,pdum3,pdum4,pdum5,jdum)
3890 CALL
dadmkk( 1,idum,pdum,pdum1,pdum2)
3891 CALL
dadmks( 1,idum,hdum,pdum1,pdum2,pdum3,pdum4,jdum)
3892 CALL
dadnew( 1,idum,hdum,pdum1,pdum2,pdumx,jdum)
3893 WRITE(iout,10100) nev1,nev2,nevtot
3894 WRITE(iout,10200) (nevdec(i),gampmc(i),gamper(i),i= 1,7)
3895 WRITE(iout,10300) (nevdec(i),gampmc(i),gamper(i),names(i-7),
3908 10000
FORMAT(///1
x,15(5h*****)
3909 + /,
' *', 25
x,
'*****TAUOLA LIBRARY: VERSION 2.5 ******',9
x,1h*,
3910 + /,
' *', 25
x,
'***********JUNE 1994***************',9
x,1h*,
3911 + /,
' *', 25
x,
'**AUTHORS: S.JADACH, Z.WAS*************',9
x,1h*,
3912 + /,
' *', 25
x,
'**R. DECKER, M. JEZABEK, J.H.KUEHN*****',9
x,1h*,
3913 + /,
' *', 25
x,
'**AVAILABLE FROM: WASM AT CERNVM ******',9
x,1h*,
3914 + /,
' *', 25
x,
'***** PUBLISHED IN COMP. PHYS. COMM.***',9
x,1h*,
3915 + /,
' *', 25
x,
'*******CERN-TH-5856 SEPTEMBER 1990*****',9
x,1h*,
3916 + /,
' *', 25
x,
'*******CERN-TH-6195 SEPTEMBER 1991*****',9
x,1h*,
3917 + /,
' *', 25
x,
'*******CERN TH-6793 NOVEMBER 1992*****',9
x,1h*,
3918 + /,
' *', 25
x,
'**5 OR MORE PI DEC.: PRECISION LIMITED ',9
x,1h*,
3919 + /,
' *', 25
x,
'****DEKAY ROUTINE: INITIALIZATION******',9
x,1h*,
3920 + /,
' *',i20 ,5
x,
'JAK1 = DECAY MODE TAU+ ',9
x,1h*,
3921 + /,
' *',i20 ,5
x,
'JAK2 = DECAY MODE TAU- ',9
x,1h*,
3922 + /,1
x,15(5h*****)/)
3923 10100
FORMAT(///1
x,15(5h*****)
3924 + /,
' *', 25
x,
'*****TAUOLA LIBRARY: VERSION 2.5 ******',9
x,1h*,
3925 + /,
' *', 25
x,
'***********JUNE 1994***************',9
x,1h*,
3926 + /,
' *', 25
x,
'**AUTHORS: S.JADACH, Z.WAS*************',9
x,1h*,
3927 + /,
' *', 25
x,
'**R. DECKER, M. JEZABEK, J.H.KUEHN*****',9
x,1h*,
3928 + /,
' *', 25
x,
'**AVAILABLE FROM: WASM AT CERNVM ******',9
x,1h*,
3929 + /,
' *', 25
x,
'***** PUBLISHED IN COMP. PHYS. COMM.***',9
x,1h*,
3930 + /,
' *', 25
x,
'*******CERN-TH-5856 SEPTEMBER 1990*****',9
x,1h*,
3931 + /,
' *', 25
x,
'*******CERN-TH-6195 SEPTEMBER 1991*****',9
x,1h*,
3932 + /,
' *', 25
x,
'*******CERN TH-6793 NOVEMBER 1992*****',9
x,1h*,
3933 + /,
' *', 25
x,
'*****DEKAY ROUTINE: FINAL REPORT*******',9
x,1h*,
3934 + /,
' *',i20 ,5
x,
'NEV1 = NO. OF TAU+ DECS. ACCEPTED ',9
x,1h*,
3935 + /,
' *',i20 ,5
x,
'NEV2 = NO. OF TAU- DECS. ACCEPTED ',9
x,1h*,
3936 + /,
' *',i20 ,5
x,
'NEVTOT = SUM ',9
x,1h*,
3937 + /,
' *',
' NOEVTS ',
3938 +
' PART.WIDTH ERROR ROUTINE DECAY MODE ',9
x,1h*)
3940 + ,i10,2f12.7 ,
' DADMEL ELECTRON ',9
x,1h*
3941 + /,
' *',i10,2f12.7 ,
' DADMMU MUON ',9
x,1h*
3942 + /,
' *',i10,2f12.7 ,
' DADMPI PION ',9
x,1h*
3943 + /,
' *',i10,2f12.7,
' DADMRO RHO (->2PI) ',9
x,1h*
3944 + /,
' *',i10,2f12.7,
' DADMAA A1 (->3PI) ',9
x,1h*
3945 + /,
' *',i10,2f12.7,
' DADMKK KAON ',9
x,1h*
3946 + /,
' *',i10,2f12.7,
' DADMKS K* ',9
x,1h*)
3948 + ,i10,2f12.7,a31 ,8
x,1h*)
3950 + ,20
x,
'THE ERROR IS RELATIVE AND PART.WIDTH ',10
x,1h*
3951 + /,
' *',20
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',10
x,1h*
3952 + /,1
x,15(5h*****)/)
3954 10500
FORMAT(
' ----- DEKAY: LACK OF INITIALISATION')
3957 10600
FORMAT(
' ----- DEKAY: WRONG VALUE OF KTO ')
3964 SUBROUTINE dekay1(IMOD,HH,ISGN)
3967 COMMON / decp4 / pp1(4),pp2(4),kf1,kf2
3968 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
3969 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
3970 REAL*4 gampmc ,gamper
3972 REAL hv(4),pnu(4),ppi(4)
3973 REAL pwb(4),pmu(4),pnm(4)
3974 REAL prho(4),pic(4),piz(4)
3975 REAL paa(4),pim1(4),pim2(4),pipl(4)
3980 DATA nev,nprin/0,10/
3982 IF(jak1.EQ.-1)
RETURN
3987 IF(jak1.EQ.0) CALL
jaker(jak)
3989 CALL
dadmel(0, isgn,hv,pnu,pwb,pmu,pnm,phot)
3990 ELSEIF(jak.EQ.2)
THEN
3991 CALL
dadmmu(0, isgn,hv,pnu,pwb,pmu,pnm,phot)
3992 ELSEIF(jak.EQ.3)
THEN
3993 CALL
dadmpi(0, isgn,hv,ppi,pnu)
3994 ELSEIF(jak.EQ.4)
THEN
3995 CALL
dadmro(0, isgn,hv,pnu,prho,pic,piz)
3996 ELSEIF(jak.EQ.5)
THEN
3997 CALL
dadmaa(0, isgn,hv,pnu,paa,pim1,pim2,pipl,jaa)
3998 ELSEIF(jak.EQ.6)
THEN
3999 CALL
dadmkk(0, isgn,hv,pkk,pnu)
4000 ELSEIF(jak.EQ.7)
THEN
4001 CALL
dadmks(0, isgn,hv,pnu,pks ,pkk,ppi,jkst)
4003 CALL
dadnew(0, isgn,hv,pnu,pwb,pnpi,jak-7)
4009 ELSEIF(imd.EQ.1)
THEN
4013 nevdec(jak)=nevdec(jak)+1
4018 CALL
dwluel(1,isgn,pnu,pwb,pmu,pnm)
4019 CALL
dwrph(ktom,phot)
4023 ELSEIF(jak.EQ.2)
THEN
4024 CALL
dwlumu(1,isgn,pnu,pwb,pmu,pnm)
4025 CALL
dwrph(ktom,phot)
4029 ELSEIF(jak.EQ.3)
THEN
4030 CALL
dwlupi(1,isgn,ppi,pnu)
4034 ELSEIF(jak.EQ.4)
THEN
4035 CALL
dwluro(1,isgn,pnu,prho,pic,piz)
4039 ELSEIF(jak.EQ.5)
THEN
4040 CALL
dwluaa(1,isgn,pnu,paa,pim1,pim2,pipl,jaa)
4043 ELSEIF(jak.EQ.6)
THEN
4044 CALL
dwlukk(1,isgn,pkk,pnu)
4047 ELSEIF(jak.EQ.7)
THEN
4048 CALL
dwluks(1,isgn,pnu,pks,pkk,ppi,jkst)
4053 CALL
dwlnew(1,isgn,pnu,pwb,pnpi,jak)
4065 SUBROUTINE dekay2(IMOD,HH,ISGN)
4068 COMMON / decp4 / pp1(4),pp2(4),kf1,kf2
4069 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
4070 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
4071 REAL*4 gampmc ,gamper
4073 REAL hv(4),pnu(4),ppi(4)
4074 REAL pwb(4),pmu(4),pnm(4)
4075 REAL prho(4),pic(4),piz(4)
4076 REAL paa(4),pim1(4),pim2(4),pipl(4)
4081 DATA nev,nprin/0,10/
4083 IF(jak2.EQ.-1)
RETURN
4088 IF(jak2.EQ.0) CALL
jaker(jak)
4090 CALL
dadmel(0, isgn,hv,pnu,pwb,pmu,pnm,phot)
4091 ELSEIF(jak.EQ.2)
THEN
4092 CALL
dadmmu(0, isgn,hv,pnu,pwb,pmu,pnm,phot)
4093 ELSEIF(jak.EQ.3)
THEN
4094 CALL
dadmpi(0, isgn,hv,ppi,pnu)
4095 ELSEIF(jak.EQ.4)
THEN
4096 CALL
dadmro(0, isgn,hv,pnu,prho,pic,piz)
4097 ELSEIF(jak.EQ.5)
THEN
4098 CALL
dadmaa(0, isgn,hv,pnu,paa,pim1,pim2,pipl,jaa)
4099 ELSEIF(jak.EQ.6)
THEN
4100 CALL
dadmkk(0, isgn,hv,pkk,pnu)
4101 ELSEIF(jak.EQ.7)
THEN
4102 CALL
dadmks(0, isgn,hv,pnu,pks ,pkk,ppi,jkst)
4104 CALL
dadnew(0, isgn,hv,pnu,pwb,pnpi,jak-7)
4109 ELSEIF(imd.EQ.1)
THEN
4113 nevdec(jak)=nevdec(jak)+1
4118 CALL
dwluel(2,isgn,pnu,pwb,pmu,pnm)
4119 CALL
dwrph(ktom,phot)
4123 ELSEIF(jak.EQ.2)
THEN
4124 CALL
dwlumu(2,isgn,pnu,pwb,pmu,pnm)
4125 CALL
dwrph(ktom,phot)
4129 ELSEIF(jak.EQ.3)
THEN
4130 CALL
dwlupi(2,isgn,ppi,pnu)
4134 ELSEIF(jak.EQ.4)
THEN
4135 CALL
dwluro(2,isgn,pnu,prho,pic,piz)
4139 ELSEIF(jak.EQ.5)
THEN
4140 CALL
dwluaa(2,isgn,pnu,paa,pim1,pim2,pipl,jaa)
4143 ELSEIF(jak.EQ.6)
THEN
4144 CALL
dwlukk(2,isgn,pkk,pnu)
4147 ELSEIF(jak.EQ.7)
THEN
4148 CALL
dwluks(2,isgn,pnu,pks,pkk,ppi,jkst)
4153 CALL
dwlnew(2,isgn,pnu,pwb,pnpi,jak)
4164 SUBROUTINE dexaa(MODE,ISGN,POL,PNU,PAA,PIM1,PIM2,PIPL,JAA)
4175 COMMON / inout / inut,iout
4176 REAL pol(4),hv(4),paa(4),pnu(4),pim1(4),pim2(4),pipl(4)
4182 CALL
dadmaa( -1,isgn,hv,pnu,paa,pim1,pim2,pipl,jaa)
4185 ELSEIF(mode.EQ. 0)
THEN
4188 IF(iwarm.EQ.0) goto 20
4189 CALL
dadmaa( 0,isgn,hv,pnu,paa,pim1,pim2,pipl,jaa)
4190 wt=(1+pol(1)*hv(1)+pol(2)*hv(2)+pol(3)*hv(3))/2.
4193 IF(rn.GT.wt) goto 10
4195 ELSEIF(mode.EQ. 1)
THEN
4197 CALL
dadmaa( 1,isgn,hv,pnu,paa,pim1,pim2,pipl,jaa)
4202 20
WRITE(iout, 10000)
4203 10000
FORMAT(
' ----- DEXAA: LACK OF INITIALISATION')
4211 SUBROUTINE dexay(KTO,POL)
4225 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
4226 REAL*4 gampmc ,gamper
4227 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
4228 COMMON / idfc / idff
4229 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
4230 COMMON / mdecomp /idffin(9,nmode),mulpik(nmode)
4232 CHARACTER names(nmode)*31
4233 COMMON / inout / inut,iout
4235 REAL pdum1(4),pdum2(4),pdum3(4),pdum4(4),pdum5(4)
4245 WRITE(iout, 10000) jak1,jak2
4249 IF(jak1.NE.-1.OR.jak2.NE.-1)
THEN
4250 CALL
dexel(-1,idum,pdum,pdum1,pdum2,pdum3,pdum4,pdum5)
4251 CALL
dexmu(-1,idum,pdum,pdum1,pdum2,pdum3,pdum4,pdum5)
4252 CALL
dexpi(-1,idum,pdum,pdum1,pdum2)
4253 CALL
dexro(-1,idum,pdum,pdum1,pdum2,pdum3,pdum4)
4254 CALL
dexaa(-1,idum,pdum,pdum1,pdum2,pdum3,pdum4,pdum5,idum)
4255 CALL
dexkk(-1,idum,pdum,pdum1,pdum2)
4256 CALL
dexks(-1,idum,pdum,pdum1,pdum2,pdum3,pdum4,idum)
4257 CALL
dexnew(-1,idum,pdum,pdum1,pdum2,pdumi,idum)
4263 ELSEIF(kto.EQ.1)
THEN
4268 IF(iwarm.EQ.0) goto 20
4269 isgn=idff/iabs(idff)
4271 CALL
dexay1(kto,jak1,jakp,pol,isgn)
4272 ELSEIF(kto.EQ.2)
THEN
4277 IF(iwarm.EQ.0) goto 20
4278 isgn=-idff/iabs(idff)
4280 CALL
dexay1(kto,jak2,jakm,pol,isgn)
4281 ELSEIF(kto.EQ.100)
THEN
4283 IF(jak1.NE.-1.OR.jak2.NE.-1)
THEN
4284 CALL
dexel( 1,idum,pdum,pdum1,pdum2,pdum3,pdum4,pdum5)
4285 CALL
dexmu( 1,idum,pdum,pdum1,pdum2,pdum3,pdum4,pdum5)
4286 CALL
dexpi( 1,idum,pdum,pdum1,pdum2)
4287 CALL
dexro( 1,idum,pdum,pdum1,pdum2,pdum3,pdum4)
4288 CALL
dexaa( 1,idum,pdum,pdum1,pdum2,pdum3,pdum4,pdum5,idum)
4289 CALL
dexkk( 1,idum,pdum,pdum1,pdum2)
4290 CALL
dexks( 1,idum,pdum,pdum1,pdum2,pdum3,pdum4,idum)
4291 CALL
dexnew( 1,idum,pdum,pdum1,pdum2,pdumi,idum)
4292 WRITE(iout,10100) nev1,nev2,nevtot
4293 WRITE(iout,10200) (nevdec(i),gampmc(i),gamper(i),i= 1,7)
4294 WRITE(iout,10300) (nevdec(i),gampmc(i),gamper(i),names(i-7),
4302 10000
FORMAT(///1
x,15(5h*****)
4303 + /,
' *', 25
x,
'*****TAUOLA LIBRARY: VERSION 2.5 ******',9
x,1h*,
4304 + /,
' *', 25
x,
'***********JUNE 1994***************',9
x,1h*,
4305 + /,
' *', 25
x,
'**AUTHORS: S.JADACH, Z.WAS*************',9
x,1h*,
4306 + /,
' *', 25
x,
'**R. DECKER, M. JEZABEK, J.H.KUEHN*****',9
x,1h*,
4307 + /,
' *', 25
x,
'**AVAILABLE FROM: WASM AT CERNVM ******',9
x,1h*,
4308 + /,
' *', 25
x,
'***** PUBLISHED IN COMP. PHYS. COMM.***',9
x,1h*,
4309 + /,
' *', 25
x,
'*******CERN-TH-5856 SEPTEMBER 1990*****',9
x,1h*,
4310 + /,
' *', 25
x,
'*******CERN-TH-6195 SEPTEMBER 1991*****',9
x,1h*,
4311 + /,
' *', 25
x,
'*******CERN-TH-6793 NOVEMBER 1992*****',9
x,1h*,
4312 + /,
' *', 25
x,
'**5 OR MORE PI DEC.: PRECISION LIMITED ',9
x,1h*,
4313 + /,
' *', 25
x,
'******DEXAY ROUTINE: INITIALIZATION****',9
x,1h*
4314 + /,
' *',i20 ,5
x,
'JAK1 = DECAY MODE FERMION1 (TAU+) ',9
x,1h*
4315 + /,
' *',i20 ,5
x,
'JAK2 = DECAY MODE FERMION2 (TAU-) ',9
x,1h*
4316 + /,1
x,15(5h*****)/)
4319 10100
FORMAT(///1
x,15(5h*****)
4320 + /,
' *', 25
x,
'*****TAUOLA LIBRARY: VERSION 2.5 ******',9
x,1h*,
4321 + /,
' *', 25
x,
'***********JUNE 1994***************',9
x,1h*,
4322 + /,
' *', 25
x,
'**AUTHORS: S.JADACH, Z.WAS*************',9
x,1h*,
4323 + /,
' *', 25
x,
'**R. DECKER, M. JEZABEK, J.H.KUEHN*****',9
x,1h*,
4324 + /,
' *', 25
x,
'**AVAILABLE FROM: WASM AT CERNVM ******',9
x,1h*,
4325 + /,
' *', 25
x,
'***** PUBLISHED IN COMP. PHYS. COMM.***',9
x,1h*,
4326 + /,
' *', 25
x,
'*******CERN-TH-5856 SEPTEMBER 1990*****',9
x,1h*,
4327 + /,
' *', 25
x,
'*******CERN-TH-6195 SEPTEMBER 1991*****',9
x,1h*,
4328 + /,
' *', 25
x,
'*******CERN-TH-6793 NOVEMBER 1992*****',9
x,1h*,
4329 + /,
' *', 25
x,
'******DEXAY ROUTINE: FINAL REPORT******',9
x,1h*
4330 + /,
' *',i20 ,5
x,
'NEV1 = NO. OF TAU+ DECS. ACCEPTED ',9
x,1h*
4331 + /,
' *',i20 ,5
x,
'NEV2 = NO. OF TAU- DECS. ACCEPTED ',9
x,1h*
4332 + /,
' *',i20 ,5
x,
'NEVTOT = SUM ',9
x,1h*
4333 + /,
' *',
' NOEVTS ',
4334 +
' PART.WIDTH ERROR ROUTINE DECAY MODE ',9
x,1h*)
4336 + ,i10,2f12.7 ,
' DADMEL ELECTRON ',9
x,1h*
4337 + /,
' *',i10,2f12.7 ,
' DADMMU MUON ',9
x,1h*
4338 + /,
' *',i10,2f12.7 ,
' DADMPI PION ',9
x,1h*
4339 + /,
' *',i10,2f12.7,
' DADMRO RHO (->2PI) ',9
x,1h*
4340 + /,
' *',i10,2f12.7,
' DADMAA A1 (->3PI) ',9
x,1h*
4341 + /,
' *',i10,2f12.7,
' DADMKK KAON ',9
x,1h*
4342 + /,
' *',i10,2f12.7,
' DADMKS K* ',9
x,1h*)
4344 + ,i10,2f12.7,a31 ,8
x,1h*)
4346 + ,20
x,
'THE ERROR IS RELATIVE AND PART.WIDTH ',10
x,1h*
4347 + /,
' *',20
x,
'IN UNITS GFERMI**2*MASS**5/192/PI**3 ',10
x,1h*
4348 + /,1
x,15(5h*****)/)
4349 20
WRITE(iout, 10500)
4350 10500
FORMAT(
' ----- DEXAY: LACK OF INITIALISATION')
4352 30
WRITE(iout, 10600)
4353 10600
FORMAT(
' ----- DEXAY: WRONG VALUE OF KTO ')
4359 SUBROUTINE dexay1(KTO,JAKIN,JAK,POL,ISGN)
4365 COMMON / taubmc / gampmc(30),gamper(30),nevdec(30)
4366 REAL*4 gampmc ,gamper
4367 COMMON / inout / inut,iout
4368 REAL pol(4),polar(4)
4370 REAL prho(4),pic(4),piz(4)
4371 REAL pwb(4),pmu(4),pnm(4)
4372 REAL paa(4),pim1(4),pim2(4),pipl(4)
4378 IF(jakin.EQ.-1)
RETURN
4385 IF(jak.EQ.0) CALL
jaker(jak)
4388 CALL
dexel(0, isgn,polar,pnu,pwb,pmu,pnm,phot)
4389 CALL
dwluel(kto,isgn,pnu,pwb,pmu,pnm)
4390 CALL
dwrph(kto,phot )
4391 ELSEIF(jak.EQ.2)
THEN
4392 CALL
dexmu(0, isgn,polar,pnu,pwb,pmu,pnm,phot)
4393 CALL
dwlumu(kto,isgn,pnu,pwb,pmu,pnm)
4394 CALL
dwrph(kto,phot )
4395 ELSEIF(jak.EQ.3)
THEN
4396 CALL
dexpi(0, isgn,polar,ppi,pnu)
4397 CALL
dwlupi(kto,isgn,ppi,pnu)
4398 ELSEIF(jak.EQ.4)
THEN
4399 CALL
dexro(0, isgn,polar,pnu,prho,pic,piz)
4400 CALL
dwluro(kto,isgn,pnu,prho,pic,piz)
4401 ELSEIF(jak.EQ.5)
THEN
4402 CALL
dexaa(0, isgn,polar,pnu,paa,pim1,pim2,pipl,jaa)
4403 CALL
dwluaa(kto,isgn,pnu,paa,pim1,pim2,pipl,jaa)
4404 ELSEIF(jak.EQ.6)
THEN
4405 CALL
dexkk(0, isgn,polar,pkk,pnu)
4406 CALL
dwlukk(kto,isgn,pkk,pnu)
4407 ELSEIF(jak.EQ.7)
THEN
4408 CALL
dexks(0, isgn,polar,pnu,pks,pkk,ppi,jkst)
4409 CALL
dwluks(kto,isgn,pnu,pks,pkk,ppi,jkst)
4412 CALL
dexnew(0, isgn,polar,pnu,pwb,pnpi,jnpi)
4413 CALL
dwlnew(kto,isgn,pnu,pwb,pnpi,jak)
4415 nevdec(jak)=nevdec(jak)+1
4420 SUBROUTINE dexel(MODE,ISGN,POL,PNU,PWB,Q1,Q2,PH)
4427 REAL pol(4),hv(4),pwb(4),pnu(4),q1(4),q2(4),ph(4)
4433 CALL
dadmel( -1,isgn,hv,pnu,pwb,q1,q2,ph)
4436 ELSEIF(mode.EQ. 0)
THEN
4439 IF(iwarm.EQ.0) goto 20
4440 CALL
dadmel( 0,isgn,hv,pnu,pwb,q1,q2,ph)
4441 wt=(1+pol(1)*hv(1)+pol(2)*hv(2)+pol(3)*hv(3))/2.
4444 IF(rn.GT.wt) goto 10
4446 ELSEIF(mode.EQ. 1)
THEN
4448 CALL
dadmel( 1,isgn,hv,pnu,pwb,q1,q2,ph)
4454 10000
FORMAT(
' ----- DEXEL: LACK OF INITIALISATION')
4460 SUBROUTINE dexkk(MODE,ISGN,POL,PKK,PNU)
4467 REAL pol(4),hv(4),pnu(4),pkk(4)
4471 CALL
dadmkk(-1,isgn,hv,pkk,pnu)
4474 ELSEIF(mode.EQ. 0)
THEN
4477 CALL
dadmkk( 0,isgn,hv,pkk,pnu)
4478 wt=(1+pol(1)*hv(1)+pol(2)*hv(2)+pol(3)*hv(3))/2.
4481 IF(rn.GT.wt) goto 10
4483 ELSEIF(mode.EQ. 1)
THEN
4485 CALL
dadmkk( 1,isgn,hv,pkk,pnu)
4494 SUBROUTINE dexks(MODE,ISGN,POL,PNU,PKS,PKK,PPI,JKST)
4506 COMMON / inout / inut,iout
4507 REAL pol(4),hv(4),pks(4),pnu(4),pkk(4),ppi(4)
4514 CALL
dadmks( -1,isgn,hv,pnu,pks,pkk,ppi,jkst)
4518 ELSEIF(mode.EQ. 0)
THEN
4521 IF(iwarm.EQ.0) goto 20
4522 CALL
dadmks( 0,isgn,hv,pnu,pks,pkk,ppi,jkst)
4523 wt=(1+pol(1)*hv(1)+pol(2)*hv(2)+pol(3)*hv(3))/2.
4528 IF(rn.GT.wt) goto 10
4530 ELSEIF(mode.EQ. 1)
THEN
4532 CALL
dadmks( 1,isgn,hv,pnu,pks,pkk,ppi,jkst)
4538 20
WRITE(iout, 10000)
4539 10000
FORMAT(
' ----- DEXKS: LACK OF INITIALISATION')
4545 SUBROUTINE dexmu(MODE,ISGN,POL,PNU,PWB,Q1,Q2,PH)
4554 COMMON / inout / inut,iout
4555 REAL pol(4),hv(4),pwb(4),pnu(4),q1(4),q2(4),ph(4)
4561 CALL
dadmmu( -1,isgn,hv,pnu,pwb,q1,q2,ph)
4564 ELSEIF(mode.EQ. 0)
THEN
4567 IF(iwarm.EQ.0) goto 20
4568 CALL
dadmmu( 0,isgn,hv,pnu,pwb,q1,q2,ph)
4569 wt=(1+pol(1)*hv(1)+pol(2)*hv(2)+pol(3)*hv(3))/2.
4572 IF(rn.GT.wt) goto 10
4574 ELSEIF(mode.EQ. 1)
THEN
4576 CALL
dadmmu( 1,isgn,hv,pnu,pwb,q1,q2,ph)
4581 20
WRITE(iout, 10000)
4582 10000
FORMAT(
' ----- DEXMU: LACK OF INITIALISATION')
4589 SUBROUTINE dexnew(MODE,ISGN,POL,PNU,PAA,PNPI,JNPI)
4600 COMMON / inout / inut,iout
4601 REAL pol(4),hv(4),paa(4),pnu(4),pnpi(4,9)
4607 CALL
dadnew( -1,isgn,hv,pnu,paa,pnpi,jdumm)
4610 ELSEIF(mode.EQ. 0)
THEN
4613 IF(iwarm.EQ.0) goto 20
4614 CALL
dadnew( 0,isgn,hv,pnu,paa,pnpi,jnpi)
4615 wt=(1+pol(1)*hv(1)+pol(2)*hv(2)+pol(3)*hv(3))/2.
4618 IF(rn.GT.wt) goto 10
4620 ELSEIF(mode.EQ. 1)
THEN
4622 CALL
dadnew( 1,isgn,hv,pnu,paa,pnpi,jdumm)
4627 20
WRITE(iout, 10000)
4628 10000
FORMAT(
' ----- DEXNEW: LACK OF INITIALISATION')
4634 SUBROUTINE dexpi(MODE,ISGN,POL,PPI,PNU)
4641 REAL pol(4),hv(4),pnu(4),ppi(4)
4645 CALL
dadmpi(-1,isgn,hv,ppi,pnu)
4648 ELSEIF(mode.EQ. 0)
THEN
4651 CALL
dadmpi( 0,isgn,hv,ppi,pnu)
4652 wt=(1+pol(1)*hv(1)+pol(2)*hv(2)+pol(3)*hv(3))/2.
4655 IF(rn.GT.wt) goto 10
4657 ELSEIF(mode.EQ. 1)
THEN
4659 CALL
dadmpi( 1,isgn,hv,ppi,pnu)
4668 SUBROUTINE dexro(MODE,ISGN,POL,PNU,PRO,PIC,PIZ)
4677 COMMON / inout / inut,iout
4678 REAL pol(4),hv(4),pro(4),pnu(4),pic(4),piz(4)
4684 CALL
dadmro( -1,isgn,hv,pnu,pro,pic,piz)
4688 ELSEIF(mode.EQ. 0)
THEN
4691 IF(iwarm.EQ.0) goto 20
4692 CALL
dadmro( 0,isgn,hv,pnu,pro,pic,piz)
4693 wt=(1+pol(1)*hv(1)+pol(2)*hv(2)+pol(3)*hv(3))/2.
4698 IF(rn.GT.wt) goto 10
4700 ELSEIF(mode.EQ. 1)
THEN
4702 CALL
dadmro( 1,isgn,hv,pnu,pro,pic,piz)
4708 20
WRITE(iout, 10000)
4709 10000
FORMAT(
' ----- DEXRO: LACK OF INITIALISATION')
4717 DOUBLE PRECISION FUNCTION dfun(NDIM,X)
4719 DOUBLE PRECISION x(ndim)
4728 IMPLICIT REAL*8(
a-h,o-
z)
4731 IF(
x .LT.-1.0) go to 10
4732 IF(
x .LE. 0.5) go to 20
4733 IF(
x .EQ. 1.0) go to 30
4734 IF(
x .LE. 2.0) go to 40
4744 30
dilog=1.64493406684822
4748 z=1.64493406684822 -
log(
x)*
log(abs(
t))
4749 50
y=2.66666666666666 *
t+0.66666666666666
4750 b= 0.00000 00000 00001
4751 a=
y*b +0.00000 00000 00004
4752 b=
y*
a-b+0.00000 00000 00011
4753 a=
y*b-
a+0.00000 00000 00037
4754 b=
y*
a-b+0.00000 00000 00121
4755 a=
y*b-
a+0.00000 00000 00398
4756 b=
y*
a-b+0.00000 00000 01312
4757 a=
y*b-
a+0.00000 00000 04342
4758 b=
y*
a-b+0.00000 00000 14437
4759 a=
y*b-
a+0.00000 00000 48274
4760 b=
y*
a-b+0.00000 00001 62421
4761 a=
y*b-
a+0.00000 00005 50291
4762 b=
y*
a-b+0.00000 00018 79117
4763 a=
y*b-
a+0.00000 00064 74338
4764 b=
y*
a-b+0.00000 00225 36705
4765 a=
y*b-
a+0.00000 00793 87055
4766 b=
y*
a-b+0.00000 02835 75385
4767 a=
y*b-
a+0.00000 10299 04264
4768 b=
y*
a-b+0.00000 38163 29463
4769 a=
y*b-
a+0.00001 44963 00557
4770 b=
y*
a-b+0.00005 68178 22718
4771 a=
y*b-
a+0.00023 20021 96094
4772 b=
y*
a-b+0.00100 16274 96164
4773 a=
y*b-
a+0.00468 63619 59447
4774 b=
y*
a-b+0.02487 93229 24228
4775 a=
y*b-
a+0.16607 30329 27855
4776 a=
y*
a-b+1.93506 43008 6996
4795 REAL*4 FUNCTION distrr(DUMMY)
4798 parameter(icento=100)
4802 parameter(lux_level=4)
4803 INTEGER*4 jtau(100),jpri(100),jstro(100)
4805 common/jettagl/jtau,jpri,jstro
4806 common/ntupla/ftuple,isfirst
4807 common/beam/spec(icento)
4808 COMMON /maxspec/rmaxspec,rintspec
4809 common/sav/xminsav(icento),xmaxsav(icento),yminsav(icento),
4810 & ymaxsav(icento),q2minsav(icento),q2maxsav(icento),
4811 & w2minsav(icento),w2maxsav(icento),parimax(icento),
4812 & ppsave(icento,3,4,5),paricor(icento),
index,sigmasav(icento),
4816 common/cfread/space(5000)
4817 common/mykeys/ievar,if5cc,ineut,iinte,iferm,iflat,icoun,
4818 & refix,imudo,ikat1,ikat2,ikat3,ikat4,ikat5,ikat6,
4819 & inevt,ijak1,ijak2,iitdk,rptau,rxk0d,ntgr,idimuon,iglu,
4820 & iqden,lome(2),ifiles,iccha,iseed,idsubs,ionem,ehac,ipsel,
4825 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
4826 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
4827 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
4828 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
4835 itest=(dummy-1.5)/3.+1
4839 dice=
rndmm(iseed)*xmsigma
4840 ene1=(itest-1)*3. + 1.5
4841 ene2=(itest)*3. + 1.5
4842 IF (itest.EQ.0) ene1=0
4843 IF (itest.NE.0)
THEN
4848 s2=sigmasav(itest+1)
4849 xsect=(dummy-ene1)/(ene2-ene1)*(s2-s1)+s1
4852 IF (dice.GT.xsect)
THEN
4860 WRITE(*,*)
'+++DISTR WARNING: OUTOFRANGE',
index
4865 pari(32)=paricor(
index)
4866 pari(lst(23))=parimax(
index)
4871 q2min=q2minsav(
index)
4872 q2max=q2maxsav(
index)
4873 w2min=w2minsav(
index)
4874 w2max=w2maxsav(
index)
4877 20 psave(3,ia,ja)=ppsave(
index,3,ia,ja)
4890 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
4891 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
4892 &q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
4896 IF(lst(31).EQ.1)
THEN
4897 dlower=max(q2min,v1*ymin*
s,(w2min-pm2)*v1/max(1.-v1,1.
e-22))
4898 ELSEIF(lst(31).EQ.2)
THEN
4899 dlower=max(ymin,q2min/(
s*v1),(w2min-pm2)/max(
s*(1.-v1),1.
e-22))
4900 ELSEIF(lst(31).EQ.3)
THEN
4901 dlower=max(w2min,(1.-v1)*ymin*
s+pm2,
4902 & q2min*(1.-v1)/max(v1,1.
e-22)+pm2)
4910 SUBROUTINE dph4pi(DGAMT,HV,PN,PAA,PMULT,JNPI)
4915 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
4916 + ,ampiz,ampi,amro,gamro,ama1,gama1
4917 + ,amk,amkz,amkst,gamkst
4919 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
4920 + ,ampiz,ampi,amro,gamro,ama1,gama1
4921 + ,amk,amkz,amkst,gamkst
4922 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
4923 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
4924 REAL hv(4),
pt(4),pn(4),paa(4),pim1(4),pim2(4),pipl(4),pmult(4,9)
4927 REAL*8 uu,
ff,ff1,ff2,ff3,ff4,gg1,gg2,gg3,gg4,rr
4928 DATA pi /3.141592653589793238462643/
4935 phspac=1./2**23/pi**11
4961 CALL
choice(100+jnpi,rr,ichan,prob1,prob2,prob3,
4962 + amrop,gamrop,amrx,gamrx,amrb,gamrb)
4976 ams1=(amp1+amp2+amp3+amp4)**2
4977 ams2=(amtau-amnuta)**2
4978 alp1=atan((ams1-amrop**2)/amrop/gamrop)
4979 alp2=atan((ams2-amrop**2)/amrop/gamrop)
4980 alp=alp1+rr1*(alp2-alp1)
4981 am4sq =amrop**2+amrop*gamrop*
tan(alp)
4983 phspac=phspac* ((am4sq-amrop**2)**2+(amrop*gamrop)**2)/(amrop*
4985 phspac=phspac*(alp2-alp1)
4989 ams1=(amp2+amp3+amp4)**2
4991 IF (rrr(9).GT.prez)
THEN
4992 am3sq=ams1+ rr1*(ams2-ams1)
4998 alp1=atan((ams1-amrx**2)/amrx/gamrx)
4999 alp2=atan((ams2-amrx**2)/amrx/gamrx)
5000 alp=alp1+rr1*(alp2-alp1)
5001 am3sq =amrx**2+amrx*gamrx*
tan(alp)
5004 ff1=((am3sq-amrx**2)**2+(amrx*gamrx)**2)/(amrx*gamrx)
5012 am2sq=ams1+ rr2*(ams2-ams1)
5017 enq1=(am2sq-amp3**2+amp4**2)/(2*am2)
5018 enq2=(am2sq+amp3**2-amp4**2)/(2*am2)
5019 ppi= enq1**2-amp4**2
5020 pppi=
sqrt(abs(enq1**2-amp4**2))
5021 phspac=phspac*(4*pi)*(2*pppi/am2)
5033 pr(4)=1./(2*am3)*(am3**2+am2**2-amp2**2)
5034 pr(3)=
sqrt(abs(pr(4)**2-am2**2))
5035 ppi = pr(4)**2-am2**2
5039 pim1(4)=1./(2*am3)*(am3**2-am2**2+amp2**2)
5042 ff3=(4*pi)*(2*pr(3)/am3)
5044 exe=(pr(4)+pr(3))/am2
5046 CALL
bostr3(exe,pipl,pipl)
5049 thet =acos(-1.+2*rr3)
5059 pr(4)=1./(2*am4)*(am4**2+am3**2-amp1**2)
5060 pr(3)=
sqrt(abs(pr(4)**2-am3**2))
5061 ppi = pr(4)**2-am3**2
5065 pim2(4)=1./(2*am4)*(am4**2-am3**2+amp1**2)
5068 ff4=(4*pi)*(2*pr(3)/am4)
5070 exe=(pr(4)+pr(3))/am3
5072 CALL
bostr3(exe,pipl,pipl)
5073 CALL
bostr3(exe,pim1,pim1)
5076 thet =acos(-1.+2*rr3)
5088 paa(4)=1./(2*amtau)*(amtau**2-amnuta**2+am4**2)
5089 paa(3)=
sqrt(abs(paa(4)**2-am4**2))
5090 ppi = paa(4)**2-am4**2
5091 phspac=phspac*(4*pi)*(2*paa(3)/amtau)
5092 phsp=phsp*(4*pi)*(2*paa(3)/amtau)
5096 pn(4)=1./(2*amtau)*(amtau**2+amnuta**2-am4**2)
5100 am3sq=(pim1(4)+piz(4)+pipl(4))**2-(pim1(3)+piz(3)+pipl(3))**2
5101 +-(pim1(2)+piz(2)+pipl(2))**2-(pim1(1)+piz(1)+pipl(1))**2
5103 ams1=(amp1+amp3+amp4)**2
5106 ams2=(
sqrt(am3sq)-amp1)**2
5108 ff3=(4*pi)*(xlam(am2**2,amp1**2,am3sq)/am3sq)
5109 ff4=(4*pi)*(xlam(am3sq,amp2**2,am4**2)/am4**2)
5112 am3sq=(pim1(4)+piz(4)+pipl(4))**2-(pim1(3)+piz(3)+pipl(3))**2
5113 +-(pim1(2)+piz(2)+pipl(2))**2-(pim1(1)+piz(1)+pipl(1))**2
5115 ams1=(amp1+amp3+amp4)**2
5116 alp1=atan((ams1-amrx**2)/amrx/gamrx)
5117 alp2=atan((ams2-amrx**2)/amrx/gamrx)
5118 ff1=((am3sq-amrx**2)**2+(amrx*gamrx)**2)/(amrx*gamrx)
5121 ams2=(
sqrt(am3sq)-amp1)**2
5123 ff3=(4*pi)*(xlam(am2**2,amp1**2,am3sq)/am3sq)
5124 ff4=(4*pi)*(xlam(am3sq,amp2**2,am4**2)/am4**2)
5127 am3sq=(pim2(4)+piz(4)+pipl(4))**2-(pim2(3)+piz(3)+pipl(3))**2
5128 +-(pim2(2)+piz(2)+pipl(2))**2-(pim2(1)+piz(1)+pipl(1))**2
5130 ams1=(amp2+amp3+amp4)**2
5131 alp1=atan((ams1-amrx**2)/amrx/gamrx)
5132 alp2=atan((ams2-amrx**2)/amrx/gamrx)
5133 gg1=((am3sq-amrx**2)**2+(amrx*gamrx)**2)/(amrx*gamrx)
5136 ams2=(
sqrt(am3sq)-amp2)**2
5138 gg3=(4*pi)*(xlam(am2**2,amp2**2,am3sq)/am3sq)
5139 gg4=(4*pi)*(xlam(am3sq,amp1**2,am4**2)/am4**2)
5142 IF ( ( (
ff+gg)*uu+
ff*gg ).GT.0.0d0)
THEN
5143 rr=
ff*gg*uu/(0.5*prez*(
ff+gg)*uu+(1.0-prez)*
ff*gg)
5171 exe=(paa(4)+paa(3))/am4
5173 CALL
bostr3(exe,pipl,pipl)
5174 CALL
bostr3(exe,pim1,pim1)
5175 CALL
bostr3(exe,pim2,pim2)
5185 CALL
dam4pi(jnpi,
pt,pn,pim1,pim2,piz,pipl,amplit,hv)
5186 ELSEIF (jnpi.EQ.2)
THEN
5187 CALL
dam4pi(jnpi,
pt,pn,pim1,pim2,pipl,piz,amplit,hv)
5189 dgamt=1/(2.*amtau)*amplit*phspac
5205 SUBROUTINE dph5pi(DGAMT,HV,PN,PAA,PMULT,JNPI)
5210 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
5211 + ,ampiz,ampi,amro,gamro,ama1,gama1
5212 + ,amk,amkz,amkst,gamkst
5214 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
5215 + ,ampiz,ampi,amro,gamro,ama1,gama1
5216 + ,amk,amkz,amkst,gamkst
5219 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
5220 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
5221 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
5222 COMMON / mdecomp /idffin(9,nmode),mulpik(nmode)
5224 CHARACTER names(nmode)*31
5225 REAL hv(4),
pt(4),pn(4),paa(4),pmult(4,9)
5226 REAL*4 pr(4),pi1(4),pi2(4),pi3(4),pi4(4),pi5(4)
5227 REAL*8 amp1,amp2,amp3,amp4,amp5,ams1,ams2,amom,gamom
5228 REAL*8 am5sq,am4sq,am3sq,am2sq,am5,am4,am3
5230 REAL*8 gg1,gg2,gg3,ff1,ff2,ff3,ff4,alp,alp1,alp2
5233 DATA pi /3.141592653589793238462643/
5238 bwign(xm,am,
gamma)=xm**2/cmplx(xm**2-am**2,
gamma*am)
5245 phspac=1./2**29/pi**14
5248 amp1=
dcdmas(idffin(1,jnpi))
5249 amp2=
dcdmas(idffin(2,jnpi))
5250 amp3=
dcdmas(idffin(3,jnpi))
5251 amp4=
dcdmas(idffin(4,jnpi))
5252 amp5=
dcdmas(idffin(5,jnpi))
5267 ams1=(amp1+amp2+amp3+amp4+amp5)**2
5268 ams2=(amtau-amnuta)**2
5269 am5sq=ams1+ rr1*(ams2-ams1)
5271 phspac=phspac*(ams2-ams1)
5276 ams1=(amp2+amp3+amp4+amp5)**2
5278 am4sq=ams1+ rr1*(ams2-ams1)
5285 ams1=(amp2+amp3+amp4)**2
5287 alp1=atan((ams1-amom**2)/amom/gamom)
5288 alp2=atan((ams2-amom**2)/amom/gamom)
5289 alp=alp1+rr1*(alp2-alp1)
5290 am3sq =amom**2+amom*gamom*
tan(alp)
5293 gg2=((am3sq-amom**2)**2+(amom*gamom)**2)/(amom*gamom)
5306 am2sq=ams1+ rr2*(ams2-ams1)
5312 enq1=(am2sq+amp3**2-amp4**2)/(2*am2)
5313 enq2=(am2sq-amp3**2+amp4**2)/(2*am2)
5314 ppi= enq1**2-amp3**2
5315 pppi=
sqrt(abs(enq1**2-amp3**2))
5316 ff1=(4*pi)*(2*pppi/am2)
5329 pr(4)=1./(2*am3)*(am3**2+am2**2-amp2**2)
5330 pr(3)=
sqrt(abs(pr(4)**2-am2**2))
5331 ppi = pr(4)**2-am2**2
5335 pi2(4)=1./(2*am3)*(am3**2-am2**2+amp2**2)
5338 ff2=(4*pi)*(2*pr(3)/am3)
5340 exe=(pr(4)+pr(3))/am2
5345 thet =acos(-1.+2*rr3)
5355 pr(4)=1./(2*am4)*(am4**2+am3**2-amp5**2)
5356 pr(3)=
sqrt(abs(pr(4)**2-am3**2))
5357 ppi = pr(4)**2-am3**2
5361 pi5(4)=1./(2*am4)*(am4**2-am3**2+amp5**2)
5364 ff3=(4*pi)*(2*pr(3)/am4)
5366 exe=(pr(4)+pr(3))/am3
5372 thet =acos(-1.+2*rr3)
5383 pr(4)=1./(2*am5)*(am5**2+am4**2-amp1**2)
5384 pr(3)=
sqrt(abs(pr(4)**2-am4**2))
5385 ppi = pr(4)**2-am4**2
5389 pi1(4)=1./(2*am5)*(am5**2-am4**2+amp1**2)
5392 ff4=(4*pi)*(2*pr(3)/am5)
5394 exe=(pr(4)+pr(3))/am4
5401 thet =acos(-1.+2*rr3)
5416 paa(4)=1./(2*amtau)*(amtau**2-amnuta**2+am5sq)
5417 paa(3)=
sqrt(abs(paa(4)**2-am5sq))
5418 ppi = paa(4)**2-am5sq
5419 phspac=phspac*(4*pi)*(2*paa(3)/amtau)
5423 pn(4)=1./(2*amtau)*(amtau**2+amnuta**2-am5**2)
5426 phspac=phspac * gg1*gg2*gg3*ff1*ff2*ff3*ff4
5430 exe=(paa(4)+paa(3))/am5
5443 qxn=paa(4)*pn(4)-paa(1)*pn(1)-paa(2)*pn(2)-paa(3)*pn(3)
5444 brak=2*(gv**2+ga**2)*(2*pxq*qxn+am5sq*pxn)
5445 + -6*(gv**2-ga**2)*amtau*amnuta*am5sq
5446 fompp = cabs(bwign(am3,amom,gamom))**2
5451 amplit=ccabib**2*gfermi**2/2. * brak
5452 amplit = amplit * fompp * fnorm
5455 dgamt=1/(2.*amtau)*amplit*phspac
5478 SUBROUTINE dphnpi(DGAMT,HVX,PNX,PRX,PPIX,JNPI)
5483 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
5484 + ,ampiz,ampi,amro,gamro,ama1,gama1
5485 + ,amk,amkz,amkst,gamkst
5487 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
5488 + ,ampiz,ampi,amro,gamro,ama1,gama1
5489 + ,amk,amkz,amkst,gamkst
5490 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
5491 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
5492 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
5493 COMMON / mdecomp /idffin(9,nmode),mulpik(nmode)
5495 CHARACTER names(nmode)*31
5498 REAL*8 pn(4),pr(4),ppi(4,9),hv(4)
5499 REAL*4 pnx(4),prx(4),ppix(4,9),hvx(4)
5500 REAL*8 pv(5,9),
pt(4),ue(3),be(3)
5501 REAL*8 pawt,amx,ams1,ams2,pa,phs,phsmax,pmin,pmax
5502 REAL*8 gam,bep,
phi,
a,b,c
5504 REAL*4 rrr(9),rrx(2),rtemp(1)
5506 DATA pi /3.141592653589793238462643/
5507 DATA wetmax /20*1
d-15/
5512 +
sqrt(max(0.d0,(
a**2-(b+c)**2)*(
a**2-(b-c)**2)))/(2.d0*
a)
5514 ampik(i,j)=
dcdmas(idffin(i,j))
5517 IF ((jnpi.LE.0).OR.jnpi.GT.20)
THEN
5518 WRITE(6,*)
'JNPI OUTSIDE RANGE DEFINED BY WETMAX; JNPI=',jnpi
5532 phspac = 1./2.**5 /pi**2
5534 20 ps =ps+ampik(i,jnpi)
5539 ams2=(amtau-amnuta)**2
5542 amx2=ams1+ rr1*(ams2-ams1)
5545 phspac=phspac * (ams2-ams1)
5550 pn(4)=1./(2*amtau)*(amtau**2+amnuta**2-amx2)
5551 pn(3)=-
sqrt((pn(4)-amnuta)*(pn(4)+amnuta))
5555 pr(4)=1./(2*amtau)*(amtau**2-amnuta**2+amx2)
5557 phspac=phspac * (4.*pi) * (2.*pr(3)/amtau)
5564 qxn=pr(4)*pn(4)-pr(1)*pn(1)-pr(2)*pn(2)-pr(3)*pn(3)
5567 brak=2*(gv**2+ga**2)*(2*pxq*qxn+amx2*pxn) -6*(gv**2-ga**2)*amtau*
5571 amplit=ccabib**2*gfermi**2/2. * brak * amx2*
sigee(amx2,jnpi)
5572 dgamt=1./(2.*amtau)*amplit*phspac
5579 pv(5,nd)=ampik(nd,jnpi)
5581 pmax=amw-ps+ampik(nd,jnpi)
5584 pmax=pmax+ampik(il,jnpi)
5585 pmin=pmin+ampik(il+1,jnpi)
5586 40 phsmax=phsmax*pawt(pmax,pmin,ampik(il,jnpi))/pmax
5593 50 ams1=ams1+ampik(jl,jnpi)
5595 amx =(amx-ampik(il,jnpi))
5597 phsmax=phsmax * (ams2-ams1)
5604 phspac = 1./2.**(6*nd-7) /pi**(3*nd-4)
5610 80 ams1=ams1+ampik(jl,jnpi)
5612 ams2=(amx-ampik(il,jnpi))**2
5614 amx2=ams1+ rr1*(ams2-ams1)
5617 phspac=phspac * (ams2-ams1)
5619 phs=phs* (ams2-ams1)
5620 pa=pawt(pv(5,il),pv(5,il+1),ampik(il,jnpi))
5621 phs =phs *pa/pv(5,il)
5623 pa=pawt(pv(5,nd-1),ampik(nd-1,jnpi),ampik(nd,jnpi))
5624 phs =phs *pa/pv(5,nd-1)
5628 wetmax(jnpi)=1.2d0*max(wetmax(jnpi)/1.2d0,phs/phsmax)
5629 IF (ncont.EQ.500 000)
THEN
5632 xnpi=xnpi+ampik(kk,jnpi)
5634 WRITE(6,*)
'ROUNDING INSTABILITY IN DPHNPI ?'
5635 WRITE(6,*)
'AMW=',amw,
'XNPI=',xnpi
5636 WRITE(6,*)
'IF =AMW= IS NEARLY EQUAL =XNPI= THAT IS IT'
5637 WRITE(6,*)
'PHS=',phs,
'PHSMAX=',phsmax
5640 IF(rn*phsmax*wetmax(jnpi).GT.phs) go to 70
5642 100
DO 120 il=1,nd-1
5643 pa=pawt(pv(5,il),pv(5,il+1),ampik(il,jnpi))
5651 110 pv(j,il+1)=-pa*ue(j)
5652 ppi(4,il)=
sqrt(pa**2+ampik(il,jnpi)**2)
5653 pv(4,il+1)=
sqrt(pa**2+pv(5,il+1)**2)
5654 phspac=phspac *(4.*pi)*(2.*pa/pv(5,il))
5658 130 ppi(j,nd)=pv(j,nd)
5661 140 be(j)=pv(j,il)/pv(4,il)
5662 gam=pv(4,il)/pv(5,il)
5664 bep=be(1)*ppi(1,i)+be(2)*ppi(2,i)+be(3)*ppi(3,i)
5666 150 ppi(j,i)=ppi(j,i)+gam*(gam*bep/(1.d0+gam)+ppi(4,i))*be(j)
5667 ppi(4,i)=gam*(ppi(4,i)+bep)
5687 SUBROUTINE dphsaa(DGAMT,HV,PN,PAA,PIM1,PIM2,PIPL,JAA)
5692 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
5693 + ,ampiz,ampi,amro,gamro,ama1,gama1
5694 + ,amk,amkz,amkst,gamkst
5696 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
5697 + ,ampiz,ampi,amro,gamro,ama1,gama1
5698 + ,amk,amkz,amkst,gamkst
5699 COMMON / taukle / bra1,brk0,brk0b,brks
5700 REAL*4 bra1,brk0,brk0b,brks
5701 REAL hv(4),pn(4),paa(4),pim1(4),pim2(4),pipl(4)
5711 IF (rmod.LT.bra1)
THEN
5724 +
dphtre(dgamt,hv,pn,paa,pim1,amp1,pim2,amp2,pipl,amp3,keyt,mnum)
5729 SUBROUTINE dphsel(DGAMX,HVX,XNX,PAAX,QPX,XAX,PHX)
5735 REAL*4 hvx(4),paax(4),xax(4),qpx(4),xnx(4)
5736 REAL*8 hv(4),ph(4),paa(4),xa(4),qp(4),xn(4)
5739 CALL
drcmu(dgamt,hv,ph,paa,xa,qp,xn,ielmu)
5753 SUBROUTINE dphsks(DGAMT,HV,PN,PKS,PKK,PPI,JKST)
5760 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
5761 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
5762 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
5763 * ,ampiz,ampi,amro,gamro,ama1,gama1
5764 * ,amk,amkz,amkst,gamkst
5766 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
5767 * ,ampiz,ampi,amro,gamro,ama1,gama1
5768 * ,amk,amkz,amkst,gamkst
5769 REAL hv(4),
pt(4),pn(4),pks(4),pkk(4),ppi(4),qq(4)
5771 DATA pi /3.141592653589793238462643/
5775 phspac=1./2**11/pi**5
5787 ams2=(amtau-amnuta)**2
5793 alp1=atan((ams1-amkst**2)/amkst/gamkst)
5794 alp2=atan((ams2-amkst**2)/amkst/gamkst)
5795 alp=alp1+rr1*(alp2-alp1)
5796 amx2=amkst**2+amkst*gamkst*
tan(alp)
5798 phspac=phspac*((amx2-amkst**2)**2+(amkst*gamkst)**2)
5800 phspac=phspac*(alp2-alp1)
5805 pn(4)=1./(2*amtau)*(amtau**2+amnuta**2-amx**2)
5806 pn(3)=-
sqrt((pn(4)-amnuta)*(pn(4)+amnuta))
5811 pks(4)=1./(2*amtau)*(amtau**2-amnuta**2+amx**2)
5813 phspac=phspac*(4*pi)*(2*pks(3)/amtau)
5816 enpi=( amx**2+ampi**2-amkz**2 ) / ( 2*amx )
5817 pppi=
sqrt((enpi-ampi)*(enpi+ampi))
5818 phspac=phspac*(4*pi)*(2*pppi/amx)
5825 pkk(4)=( amx**2+amkz**2-ampi**2 ) / ( 2*amx )
5826 exe=(pks(4)+pks(3))/amx
5831 20 qq(i)=ppi(i)-pkk(i)
5833 pksd =pks(4)*pks(4)-pks(3)*pks(3)-pks(2)*pks(2)-pks(1)*pks(1)
5834 qqpks=pks(4)* qq(4)-pks(3)* qq(3)-pks(2)* qq(2)-pks(1)* qq(1)
5836 30 qq(i)=qq(i)-pks(i)*qqpks/pksd
5839 prodnq=pn(4)*qq(4)-pn(1)*qq(1)-pn(2)*qq(2)-pn(3)*qq(3)
5841 qq2= qq(4)**2-qq(1)**2-qq(2)**2-qq(3)**2
5842 brak=(gv**2+ga**2)*(2*prodpq*prodnq-prodpn*qq2)
5843 & +(gv**2-ga**2)*amtau*amnuta*qq2
5845 fks=cabs(
bwigs(amx2,amkst,gamkst))**2
5846 amplit=(gfermi*scabib)**2*brak*2*fks
5847 dgamt=1/(2.*amtau)*amplit*phspac
5849 40 hv(i)=2*gv*ga*amtau*(2*prodnq*qq(i)-qq2*pn(i))/brak
5852 ELSEIF(jkst.EQ.20)
THEN
5856 ams2=(amtau-amnuta)**2
5862 alp1=atan((ams1-amkst**2)/amkst/gamkst)
5863 alp2=atan((ams2-amkst**2)/amkst/gamkst)
5864 alp=alp1+rr1*(alp2-alp1)
5865 amx2=amkst**2+amkst*gamkst*
tan(alp)
5867 phspac=phspac*((amx2-amkst**2)**2+(amkst*gamkst)**2)
5869 phspac=phspac*(alp2-alp1)
5874 pn(4)=1./(2*amtau)*(amtau**2+amnuta**2-amx**2)
5875 pn(3)=-
sqrt((pn(4)-amnuta)*(pn(4)+amnuta))
5879 pks(4)=1./(2*amtau)*(amtau**2-amnuta**2+amx**2)
5881 phspac=phspac*(4*pi)*(2*pks(3)/amtau)
5884 enpi=( amx**2+ampiz**2-amk**2 ) / ( 2*amx )
5885 pppi=
sqrt((enpi-ampiz)*(enpi+ampiz))
5886 phspac=phspac*(4*pi)*(2*pppi/amx)
5893 pkk(4)=( amx**2+amk**2-ampiz**2 ) / ( 2*amx )
5894 exe=(pks(4)+pks(3))/amx
5899 60 qq(i)=pkk(i)-ppi(i)
5901 pksd =pks(4)*pks(4)-pks(3)*pks(3)-pks(2)*pks(2)-pks(1)*pks(1)
5902 qqpks=pks(4)* qq(4)-pks(3)* qq(3)-pks(2)* qq(2)-pks(1)* qq(1)
5904 70 qq(i)=qq(i)-pks(i)*qqpks/pksd
5907 prodnq=pn(4)*qq(4)-pn(1)*qq(1)-pn(2)*qq(2)-pn(3)*qq(3)
5909 qq2= qq(4)**2-qq(1)**2-qq(2)**2-qq(3)**2
5910 brak=(gv**2+ga**2)*(2*prodpq*prodnq-prodpn*qq2)
5911 & +(gv**2-ga**2)*amtau*amnuta*qq2
5913 fks=cabs(
bwigs(amx2,amkst,gamkst))**2
5914 amplit=(gfermi*scabib)**2*brak*2*fks
5915 dgamt=1/(2.*amtau)*amplit*phspac
5917 80 hv(i)=2*gv*ga*amtau*(2*prodnq*qq(i)-qq2*pn(i))/brak
5924 SUBROUTINE dphsmu(DGAMX,HVX,XNX,PAAX,QPX,XAX,PHX)
5930 REAL*4 hvx(4),paax(4),xax(4),qpx(4),xnx(4)
5931 REAL*8 hv(4),ph(4),paa(4),xa(4),qp(4),xn(4)
5934 CALL
drcmu(dgamt,hv,ph,paa,xa,qp,xn,ielmu)
5949 SUBROUTINE dphspk(DGAMT,HV,PN,PAA,PNPI,JAA)
5954 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
5955 COMMON / mdecomp /idffin(9,nmode),mulpik(nmode)
5957 CHARACTER names(nmode)*31
5959 REAL hv(4),pn(4),paa(4),pim1(4),pim2(4),pipl(4),pnpi(4,9)
5966 amp1=
dcdmas(idffin(1,jaa+nm4+nm5+nm6))
5967 amp2=
dcdmas(idffin(2,jaa+nm4+nm5+nm6))
5968 amp3=
dcdmas(idffin(3,jaa+nm4+nm5+nm6))
5970 +
dphtre(dgamt,hv,pn,paa,pim1,amp1,pim2,amp2,pipl,amp3,keyt,mnum)
5981 SUBROUTINE dphsrk(DGAMT,HV,PN,PR,PMULT,INUM)
5987 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
5988 + ,ampiz,ampi,amro,gamro,ama1,gama1
5989 + ,amk,amkz,amkst,gamkst
5991 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
5992 + ,ampiz,ampi,amro,gamro,ama1,gama1
5993 + ,amk,amkz,amkst,gamkst
5994 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
5995 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
5996 REAL hv(4),
pt(4),pn(4),pr(4),pkc(4),pkz(4),qq(4),pmult(4,9)
5997 DATA pi /3.141592653589793238462643/
6001 phspac=1./2**11/pi**5
6009 ams2=(amtau-amnuta)**2
6012 amx2=ams1+ rr1*(ams2-ams1)
6014 phspac=phspac*(ams2-ams1)
6032 pn(4)=1./(2*amtau)*(amtau**2+amnuta**2-amx**2)
6033 pn(3)=-
sqrt((pn(4)-amnuta)*(pn(4)+amnuta))
6037 pr(4)=1./(2*amtau)*(amtau**2-amnuta**2+amx**2)
6039 phspac=phspac*(4*pi)*(2*pr(3)/amtau)
6042 enq1=(amx2+amk**2-amkz**2)/(2.*amx)
6043 enq2=(amx2-amk**2+amkz**2)/(2.*amx)
6044 pppi=
sqrt((enq1-amk)*(enq1+amk))
6045 phspac=phspac*(4*pi)*(2*pppi/amx)
6053 exe=(pr(4)+pr(3))/amx
6058 30 qq(i)=pkc(i)-pkz(i)
6060 pksd =pr(4)*pr(4)-pr(3)*pr(3)-pr(2)*pr(2)-pr(1)*pr(1)
6061 qqpks=pr(4)* qq(4)-pr(3)* qq(3)-pr(2)* qq(2)-pr(1)* qq(1)
6063 40 qq(i)=qq(i)-pr(i)*qqpks/pksd
6066 prodnq=pn(4)*qq(4)-pn(1)*qq(1)-pn(2)*qq(2)-pn(3)*qq(3)
6068 qq2= qq(4)**2-qq(1)**2-qq(2)**2-qq(3)**2
6069 brak=(gv**2+ga**2)*(2*prodpq*prodnq-prodpn*qq2)
6070 + +(gv**2-ga**2)*amtau*amnuta*qq2
6071 amplit=(gfermi*ccabib)**2*brak*2*
fpirk(amx)
6072 dgamt=1/(2.*amtau)*amplit*phspac
6074 50 hv(i)=2*gv*ga*amtau*(2*prodnq*qq(i)-qq2*pn(i))/brak
6084 SUBROUTINE dphsro(DGAMT,HV,PN,PR,PIC,PIZ)
6089 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
6090 * ,ampiz,ampi,amro,gamro,ama1,gama1
6091 * ,amk,amkz,amkst,gamkst
6093 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
6094 * ,ampiz,ampi,amro,gamro,ama1,gama1
6095 * ,amk,amkz,amkst,gamkst
6096 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
6097 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
6098 REAL hv(4),
pt(4),pn(4),pr(4),pic(4),piz(4),qq(4)
6099 DATA pi /3.141592653589793238462643/
6103 phspac=1./2**11/pi**5
6110 ams1=(ampi+ampiz)**2
6111 ams2=(amtau-amnuta)**2
6117 alp1=atan((ams1-amro**2)/amro/gamro)
6118 alp2=atan((ams2-amro**2)/amro/gamro)
6122 alp=alp1+rr1*(alp2-alp1)
6123 amx2=amro**2+amro*gamro*
tan(alp)
6125 IF(amx.LT.2.*ampi) go to 10
6127 phspac=phspac*((amx2-amro**2)**2+(amro*gamro)**2)/(amro*gamro)
6128 phspac=phspac*(alp2-alp1)
6133 pn(4)=1./(2*amtau)*(amtau**2+amnuta**2-amx**2)
6134 pn(3)=-
sqrt((pn(4)-amnuta)*(pn(4)+amnuta))
6138 pr(4)=1./(2*amtau)*(amtau**2-amnuta**2+amx**2)
6140 phspac=phspac*(4*pi)*(2*pr(3)/amtau)
6143 enq1=(amx2+ampi**2-ampiz**2)/(2.*amx)
6144 enq2=(amx2-ampi**2+ampiz**2)/(2.*amx)
6145 pppi=
sqrt((enq1-ampi)*(enq1+ampi))
6146 phspac=phspac*(4*pi)*(2*pppi/amx)
6154 exe=(pr(4)+pr(3))/amx
6159 30 qq(i)=pic(i)-piz(i)
6162 prodnq=pn(4)*qq(4)-pn(1)*qq(1)-pn(2)*qq(2)-pn(3)*qq(3)
6164 qq2= qq(4)**2-qq(1)**2-qq(2)**2-qq(3)**2
6165 brak=(gv**2+ga**2)*(2*prodpq*prodnq-prodpn*qq2)
6166 & +(gv**2-ga**2)*amtau*amnuta*qq2
6167 amplit=(gfermi*ccabib)**2*brak*2*
fpirho(amx)
6168 dgamt=1/(2.*amtau)*amplit*phspac
6170 40 hv(i)=2*gv*ga*amtau*(2*prodnq*qq(i)-qq2*pn(i))/brak
6178 +
dphtre(dgamt,hv,pn,paa,pim1,ampa,pim2,ampb,pipl,amp3,keyt,mnum)
6195 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
6196 + ,ampiz,ampi,amro,gamro,ama1,gama1
6197 + ,amk,amkz,amkst,gamkst
6199 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
6200 + ,ampiz,ampi,amro,gamro,ama1,gama1
6201 + ,amk,amkz,amkst,gamkst
6202 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
6203 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
6204 REAL hv(4),
pt(4),pn(4),paa(4),pim1(4),pim2(4),pipl(4)
6207 DATA pi /3.141592653589793238462643/
6214 phspac=1./2**17/pi**8
6224 CALL
choice(mnum,rr,ichan,prob1,prob2,prob3,
6225 + amrx,gamrx,amra,gamra,amrb,gamrb)
6226 IF (ichan.EQ.1)
THEN
6229 ELSEIF (ichan.EQ.2)
THEN
6238 ams1=(amp1+amp2+amp3)**2
6239 ams2=(amtau-amnuta)**2
6241 alp1=atan((ams1-amrx**2)/amrx/gamrx)
6242 alp2=atan((ams2-amrx**2)/amrx/gamrx)
6243 alp=alp1+rr1*(alp2-alp1)
6244 am3sq =amrx**2+amrx*gamrx*
tan(alp)
6246 phspac=phspac*((am3sq-amrx**2)**2+(amrx*gamrx)**2)/(amrx*gamrx)
6247 phspac=phspac*(alp2-alp1)
6252 IF (ichan.LE.2)
THEN
6254 alp1=atan((ams1-amra**2)/amra/gamra)
6255 alp2=atan((ams2-amra**2)/amra/gamra)
6256 alp=alp1+rr2*(alp2-alp1)
6257 am2sq =amra**2+amra*gamra*
tan(alp)
6265 am2sq=ams1+ rr2*(ams2-ams1)
6270 enq1=(am2sq-amp2**2+amp3**2)/(2*am2)
6271 enq2=(am2sq+amp2**2-amp3**2)/(2*am2)
6272 ppi= enq1**2-amp3**2
6273 pppi=
sqrt(abs(enq1**2-amp3**2))
6275 phf1=(4*pi)*(2*pppi/am2)
6287 pr(4)=1./(2*am3)*(am3**2+am2**2-amp1**2)
6288 pr(3)=
sqrt(abs(pr(4)**2-am2**2))
6289 ppi = pr(4)**2-am2**2
6293 pim2(4)=1./(2*am3)*(am3**2-am2**2+amp1**2)
6295 phf2=(4*pi)*(2*pr(3)/am3)
6297 exe=(pr(4)+pr(3))/am2
6298 CALL
bostr3(exe,pipl,pipl)
6299 CALL
bostr3(exe,pim1,pim1)
6303 thet =acos(-1.+2*rr3)
6314 paa(4)=1./(2*amtau)*(amtau**2-amnuta**2+am3**2)
6315 paa(3)=
sqrt(abs(paa(4)**2-am3**2))
6316 ppi = paa(4)**2-am3**2
6317 phspac=phspac*(4*pi)*(2*paa(3)/amtau)
6321 pn(4)=1./(2*amtau)*(amtau**2+amnuta**2-am3**2)
6327 alp1=atan((ams1-amra**2)/amra/gamra)
6328 alp2=atan((ams2-amra**2)/amra/gamra)
6329 xpro = (pim1(3)+pipl(3))**2 +(pim1(2)+pipl(2))**2+(pim1(1)+
6331 am2sq=-xpro+(pim1(4)+pipl(4))**2
6333 ff1 = ((am2sq-amra**2)**2+(amra*gamra)**2)/(amra*gamra)
6334 ff1 =ff1 *(alp2-alp1)
6336 gg1 = (4*pi)*(xlam(am2sq,amp2**2,amp3**2)/am2sq)
6338 gg1 =gg1 *(4*pi)*
sqrt(4*xpro/am3sq)
6339 xjaje=gg1*(ams2-ams1)
6343 alp1=atan((ams1-amrb**2)/amrb/gamrb)
6344 alp2=atan((ams2-amrb**2)/amrb/gamrb)
6345 xpro = (pim2(3)+pipl(3))**2 +(pim2(2)+pipl(2))**2+(pim2(1)+
6347 am2sq=-xpro+(pim2(4)+pipl(4))**2
6348 ff2 = ((am2sq-amrb**2)**2+(amrb*gamrb)**2)/(amrb*gamrb)
6349 ff2 =ff2 *(alp2-alp1)
6350 gg2 = (4*pi)*(xlam(am2sq,amp1**2,amp3**2)/am2sq)
6351 gg2 =gg2 *(4*pi)*
sqrt(4*xpro/am3sq)
6352 xjadw=gg2*(ams2-ams1)
6359 IF (ichan.EQ.2)
THEN
6364 IF (xjac1.NE.0.0) a1=prob1/xjac1
6365 IF (xjac2.NE.0.0) a2=prob2/xjac2
6366 IF (xjac3.NE.0.0) a3=prob3/xjac3
6368 IF (a1+a2+a3.NE.0.0)
THEN
6369 phspac=phspac/(a1+a2+a3)
6381 exe=(paa(4)+paa(3))/am3
6382 CALL
bostr3(exe,pipl,pipl)
6383 CALL
bostr3(exe,pim1,pim1)
6384 CALL
bostr3(exe,pim2,pim2)
6388 CALL
dampog(
pt,pn,pim1,pim2,pipl,amplit,hv)
6392 CALL
damppk(mnum,
pt,pn,pim1,pim2,pipl,amplit,hv)
6394 IF (keyt.EQ.1.OR.keyt.EQ.2)
THEN
6400 dgamt=1/(2.*amtau)*amplit*phspac
6407 FUNCTION dqcd(ICOSFI,IPART,IP,XP,ZP,Y)
6413 DATA c1,c2,c3,c4,c5/0.2122066,0.0795775,0.4244132,0.1591549,
6416 IF(icosfi.EQ.0)
THEN
6419 dqcd=
c1*((zp**2+xp**2)/(1.-xp)/(1.-zp)+2.*(xp*zp+1.))
6420 ELSEIF(ip.EQ.2)
THEN
6422 ELSEIF(ip.EQ.3)
THEN
6423 dqcd=
c1*((zp**2+xp**2)/(1.-xp)/(1.-zp)+2.*(xp+zp))
6425 WRITE(6,10000) icosfi,
ipart,ip
6427 ELSEIF(
ipart.EQ.2)
THEN
6429 dqcd=c2*(xp**2+(1.-xp)**2)*(zp**2+(1.-zp)**2)/(1.-zp)/zp
6430 ELSEIF(ip.EQ.2)
THEN
6431 dqcd=c2*8.*xp*(1.-xp)
6432 ELSEIF(ip.EQ.3)
THEN
6433 dqcd=c2*(xp**2+(1.-xp)**2)*(zp-(1.-zp))/(1.-zp)/zp
6435 WRITE(6,10000) icosfi,
ipart,ip
6438 WRITE(6,10000) icosfi,
ipart,ip
6441 ELSEIF(icosfi.EQ.1)
THEN
6444 dqcd=c3*
y*
sqrt((1.-
y)*xp*zp/(1.-xp)/(1.-zp))*
6445 & (1.-2./
y)*(1.-zp-xp+2.*xp*zp)
6446 ELSEIF(ip.EQ.3)
THEN
6447 dqcd=c3*
y*
sqrt((1.-
y)*xp*zp/(1.-xp)/(1.-zp))*
6450 WRITE(6,10000) icosfi,
ipart,ip
6452 ELSEIF(
ipart.EQ.2)
THEN
6454 dqcd=c4*
y*
sqrt((1.-
y)*xp*(1.-xp)/zp/(1.-zp))*
6455 & (1.-2./
y)*(1.-2.*zp)*(1.-2.*xp)
6456 ELSEIF(ip.EQ.3)
THEN
6457 dqcd=c4*
y*
sqrt((1.-
y)*xp*(1.-xp)/zp/(1.-zp))*
6460 WRITE(6,10000) icosfi,
ipart,ip
6464 ELSEIF(icosfi.EQ.2)
THEN
6466 dqcd=c3*(1.-
y)*xp*zp
6467 ELSEIF(
ipart.EQ.2)
THEN
6468 dqcd=c5*(1.-
y)*xp*(1.-xp)
6470 WRITE(6,10000) icosfi,
ipart,ip
6474 WRITE(6,10000) icosfi,
ipart,ip
6478 10000
FORMAT(
' ERROR IN ROUTINE DQCD ',
6479 &
' ICOSFI, IPART, IP = ',3i10)
6486 FUNCTION dqcdi(IPART,IP,XP,ZPMIN,ZPMAX)
6492 DATA c1,c2/0.2122066,0.0795775/
6496 zlog=alog(zpmax/zpmin)
6497 dqcdi=
c1*(xp**2*zlog+zpmin-zpmax+(zpmin**2-zpmax**2)/2.+zlog+
6498 & xp*(1.-xp)*(zpmax**2-zpmin**2)+2.*(1.-xp)*(zpmax-zpmin))
6499 ELSEIF(ip.EQ.2)
THEN
6500 dqcdi=
c1*2.*xp*(1.-xp)*(zpmax**2-zpmin**2)
6501 ELSEIF(ip.EQ.3)
THEN
6502 zlog=alog(zpmax/zpmin)
6503 dqcdi=
c1*(xp**2*zlog+zpmin-zpmax+(zpmin**2-zpmax**2)/2.+zlog+
6504 & 2.*xp*(1.-xp)*(zpmax-zpmin)+(1.-xp)*(zpmax**2-zpmin**2))
6506 WRITE(6,10000)
ipart,ip
6509 ELSEIF(
ipart.EQ.2)
THEN
6511 dqcdi=c2*(1.-xp)*(xp**2+(1.-xp)**2)*(2.*(zpmin-zpmax)+
6512 & alog(zpmax**2/zpmin**2))
6513 ELSEIF(ip.EQ.2)
THEN
6514 dqcdi=c2*8.*xp*(1.-xp)**2*(zpmax-zpmin)
6515 ELSEIF(ip.EQ.3)
THEN
6518 WRITE(6,10000)
ipart,ip
6522 WRITE(6,10000)
ipart,ip
6526 10000
FORMAT(
' ERROR IN ROUTINE DQCDI ',
6527 &
' IPART, IP = ',2i10)
6533 SUBROUTINE drcmu(DGAMT,HV,PH,PAA,XA,QP,XN,IELMU)
6534 IMPLICIT REAL*8 (
a-h,o-
z)
6539 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
6540 + ,ampiz,ampi,amro,gamro,ama1,gama1
6541 + ,amk,amkz,amkst,gamkst
6543 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
6544 + ,ampiz,ampi,amro,gamro,ama1,gama1
6545 + ,amk,amkz,amkst,gamkst
6546 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
6547 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
6548 COMMON / inout / inut,iout
6549 COMMON / taurad / xk0dec,itdkrc
6551 REAL*8 hv(4),
pt(4),ph(4),paa(4),xa(4),qp(4),xn(4)
6555 DATA pi /3.141592653589793238462643d0/
6561 phspac=1./2**17/pi**8
6571 IF (ielmu.EQ.1)
THEN
6578 IF ( itdkrc.EQ.0) prhard=0d0
6580 IF(prsoft.LT.0.1)
THEN
6581 print *,
'ERROR IN DRCMU; PRSOFT=',prsoft
6586 ihard=(rr5.GT.prsoft)
6590 ams1=(amu+amnuta)**2
6593 xl1=
log(xk1/2/xk0dec)
6598 phspac=phspac*ams2*xl1*xk
6599 phspac=phspac/prhard
6602 phspac=phspac*2**6*pi**3
6603 phspac=phspac/prsoft
6612 am2sq=ams1+ rr2*(ams2-ams1)
6614 phspac=phspac*(ams2-ams1)
6616 enq1=(am2sq+amnuta**2)/(2*am2)
6617 enq2=(am2sq-amnuta**2)/(2*am2)
6618 ppi= enq1**2-amnuta**2
6619 pppi=
sqrt(abs(enq1**2-amnuta**2))
6620 phspac=phspac*(4*pi)*(2*pppi/am2)
6632 pr(4)=1.d0/(2*am3)*(am3**2+am2**2-amu**2)
6633 pr(3)=
sqrt(abs(pr(4)**2-am2**2))
6634 ppi = pr(4)**2-am2**2
6638 qp(4)=1.d0/(2*am3)*(am3**2-am2**2+amu**2)
6640 phspac=phspac*(4*pi)*(2*pr(3)/am3)
6642 exe=(pr(4)+pr(3))/am2
6648 eps=4*(amu/amtax)**2
6649 xl1=
log((2+eps)/eps)
6654 phspac=phspac*xl1/2*
eta
6665 paa(4)=1/(2*amtax)*(amtax**2+am3**2)
6666 paa(3)=
sqrt(abs(paa(4)**2-am3**2))
6667 ppi = paa(4)**2-am3**2
6668 phspac=phspac*(4*pi)*(2*paa(3)/amtax)
6676 exe=(paa(4)+paa(3))/am3
6682 thet =acos(-1.+2*rr3)
6702 CALL
dampry(itdkrc,xk0dec,ph,xa,qp,xn,amplit,hv)
6703 dgamt=1/(2.*amtax)*amplit*phspac
6716 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
6717 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
6718 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
6719 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
6720 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
6721 dimension xpq(-6:6),pqh(17,2)
6730 IF(lst(20).EQ.0.OR.lst(17).EQ.0)
THEN
6733 IF(lst(23).EQ.1.OR.lst(24).EQ.3) iu=2
6739 zpmin=(1.-
x)*xp/(xp-
x)*parl(27)
6740 IF(zpmin.GE.0.5)
RETURN
6741 zpmax=1.d0-dble(zpmin)
6743 IF(lst(24).EQ.3) goto 80
6747 sig=
dqcdi(1,ip,xp,zpmin,zpmax)
6748 sgn=sign(1.,5.-2.*ip)
6751 IF(parl(6).GT.0.99) goto 50
6752 IF(lst(20).EQ.0.AND.lst(30).NE.-1) goto 50
6753 ELSEIF(ih.EQ.2)
THEN
6754 IF(parl(6).LT.-0.99) goto 50
6755 IF(lst(20).EQ.0.AND.lst(30).NE.1) goto 50
6757 IF(lst(20).NE.0) lst(30)=sign(1.,ih-1.5)
6758 IF(lst(23).NE.2)
THEN
6760 wq=xpq(i)*sig*(ewqc(1,ih,i)+sgn*ewqc(2,ih,i))
6761 wqb=xpq(-i)*sig*sgn*(ewqc(1,ih,i)+sgn*ewqc(2,ih,i))
6765 pqh(i,ih)=pqh(i,ih)+wq
6766 pqh(i+lst(12),ih)=pqh(i+lst(12),ih)+wqb
6767 pqh(17,ih)=pqh(17,ih)+wq+wqb
6769 ELSEIF(lst(23).EQ.2)
THEN
6771 IF(ksave(1).LT.0.AND.ih.EQ.1 .OR.ksave(1).GT.0.AND.ih.EQ.2)
6792 pqh(i,ih)=pqh(i,ih)+wq
6793 pqh(i+lst(12),ih)=pqh(i+lst(12),ih)+wqb
6794 pqh(17,ih)=pqh(17,ih)+wq+wqb
6800 70 pq(i)=(1.-parl(6))/2.*pqh(i,1)+(1.+parl(6))/2.*pqh(i,2)
6801 IF(lst(20).EQ.0)
THEN
6804 IF(lst(30).EQ.1) ih=2
6809 dsigma=pq(17)/pari(20)*parl(25)/(1.-xp)
6811 IF(lst(17).EQ.0)
THEN
6813 IF(pqh(17,1).GT.pari(15)) pari(15)=pqh(17,1)
6814 IF(pqh(17,2).GT.pari(16)) pari(16)=pqh(17,2)
6817 IF(pq(17)/pari(23+lst(20)).GT.pari(14+lst(20)))
6818 + pari(14+lst(20))=pq(17)/pari(23+lst(20))
6824 80 s13=q2*(1.-xp)/xp
6825 IF(s13.LT.4.*amu**2)
RETURN
6827 sig=xpq(0)*
dqcdi(2,ip,xp,zpmin,zpmax)
6830 IF(parl(6).GT.0.99) goto 110
6831 IF(lst(20).EQ.0.AND.lst(30).NE.-1) goto 110
6832 ELSEIF(ih.EQ.2)
THEN
6833 IF(parl(6).LT.-0.99) goto 110
6834 IF(lst(20).EQ.0.AND.lst(30).NE.1) goto 110
6836 IF(lst(20).NE.0) lst(30)=sign(1.,ih-1.5)
6837 IF(lst(23).NE.2)
THEN
6839 IF(s13.LT.4.*
ulmass(i)**2) goto 90
6840 wq=sig/2.*(ewqc(1,ih,i)+ewqc(2,ih,i))
6845 pqh(i,ih)=pqh(i,ih)+wq
6846 pqh(i+lst(13),ih)=pqh(i+lst(13),ih)+wqb
6847 pqh(17,ih)=pqh(17,ih)+wq+wqb
6849 ELSEIF(lst(23).EQ.2)
THEN
6851 IF(ksave(1).LT.0.AND.ih.EQ.1 .OR.ksave(1).GT.0.AND.ih.EQ.2)
6854 IF(s13.LT.(amu+
ulmass(i))**2) goto 100
6855 IF(k(3,2)*qc(i).LT.0)
THEN
6865 pqh(i,ih)=pqh(i,ih)+wq
6866 pqh(i+lst(13),ih)=pqh(i+lst(13),ih)+wqb
6867 pqh(17,ih)=pqh(17,ih)+wq+wqb
6873 130 pq(i)=(1.-parl(6))/2.*pqh(i,1)+(1.+parl(6))/2.*pqh(i,2)
6874 IF(lst(20).EQ.0)
THEN
6877 IF(lst(30).EQ.1) ih=2
6882 dsigma=pq(17)/pari(20)*parl(25)/(1.-xp)
6884 IF(lst(17).EQ.0)
THEN
6886 IF(pqh(17,1).GT.pari(18)) pari(18)=pqh(17,1)
6887 IF(pqh(17,2).GT.pari(19)) pari(19)=pqh(17,2)
6890 IF(pq(17)/pari(23+lst(20)).GT.pari(17+lst(20)))
6891 + pari(17+lst(20))=pq(17)/pari(23+lst(20))
6905 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
6906 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
6907 &q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
6911 IF(lst(31).EQ.1)
THEN
6912 dupper=min(q2max,v1*ymax*
s,(w2max-pm2)*v1/max(1.-v1,1.
e-22))
6913 ELSEIF(lst(31).EQ.2)
THEN
6914 dupper=min(ymax,q2max/(
s*v1),(w2max-pm2)/max(
s*(1.-v1),1.
e-22))
6915 ELSEIF(lst(31).EQ.3)
THEN
6916 dupper=min(w2max,(1.-v1)*ymax*
s+pm2,
6917 & q2max*(1.-v1)/max(v1,1.
e-22)+pm2)
6930 COMMON /
print/ iprdiv
6931 COMMON /lpflag/ lst3
6933 IF(lst3.GE.2) iprdiv=1000
6934 IF(lst3.GE.4) iprdiv=10
6935 IF(lst3.GE.4)
WRITE(6,10000) iprdiv
6937 10000
FORMAT(5
x,
'DIVON4 PRINT FLAG CHANGED: IPRDIV =',i5)
6942 SUBROUTINE dwlnew(KTO,ISGN,PNU,PWB,PNPI,MODE)
6952 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
6953 COMMON / mdecomp /idffin(9,nmode),mulpik(nmode)
6955 CHARACTER names(nmode)*31
6956 REAL pnu(4),pwb(4),pnpi(4,9)
6968 CALL
tralo4(kto,pnu,pnu,am)
6969 CALL
filhep(0,1,16*isgn,nps,nps,0,0,pnu,am,.true.)
6972 CALL
tralo4(kto,pwb,pwb,am)
6973 CALL
filhep(0,1,-24*isgn,nps,nps,0,0,pwb,am,.true.)
6980 kfpi=
lunpik(idffin(i,jnpi),-isgn)
6986 CALL
tralo4(kto,ppi,ppi,am)
6987 CALL
filhep(0,1,kfpi,-i,-i,0,0,ppi,am,.true.)
6994 SUBROUTINE dwluaa(KTO,ISGN,PNU,PAA,PIM1,PIM2,PIPL,JAA)
7005 REAL pnu(4),paa(4),pim1(4),pim2(4),pipl(4)
7015 CALL
tralo4(kto,pnu,pnu,am)
7016 CALL
filhep(0,1,16*isgn,nps,nps,0,0,pnu,am,.true.)
7019 CALL
tralo4(kto,paa,paa,am)
7020 CALL
filhep(0,1,-20213*isgn,nps,nps,0,0,paa,am,.true.)
7028 CALL
tralo4(kto,pim2,pim2,am)
7029 CALL
filhep(0,1,-211*isgn,-1,-1,0,0,pim2,am,.true.)
7032 CALL
tralo4(kto,pim1,pim1,am)
7033 CALL
filhep(0,1,-211*isgn,-2,-2,0,0,pim1,am,.true.)
7036 CALL
tralo4(kto,pipl,pipl,am)
7037 CALL
filhep(0,1, 211*isgn,-3,-3,0,0,pipl,am,.true.)
7039 ELSE IF (jaa.EQ.2)
THEN
7044 CALL
tralo4(kto,pim2,pim2,am)
7045 CALL
filhep(0,1,111,-1,-1,0,0,pim2,am,.true.)
7048 CALL
tralo4(kto,pim1,pim1,am)
7049 CALL
filhep(0,1,111,-2,-2,0,0,pim1,am,.true.)
7052 CALL
tralo4(kto,pipl,pipl,am)
7053 CALL
filhep(0,1,-211*isgn,-3,-3,0,0,pipl,am,.true.)
7061 SUBROUTINE dwluel(KTO,ISGN,PNU,PWB,PEL,PNE)
7071 REAL pnu(4),pwb(4),pel(4),pne(4)
7081 CALL
tralo4(kto,pnu,pnu,am)
7082 CALL
filhep(0,1,16*isgn,nps,nps,0,0,pnu,am,.true.)
7085 CALL
tralo4(kto,pwb,pwb,am)
7089 CALL
tralo4(kto,pel,pel,am)
7090 CALL
filhep(0,1,11*isgn,nps,nps,0,0,pel,am,.false.)
7093 CALL
tralo4(kto,pne,pne,am)
7094 CALL
filhep(0,1,-12*isgn,nps,nps,0,0,pne,am,.true.)
7100 SUBROUTINE dwlukk (KTO,ISGN,PKK,PNU)
7119 CALL
tralo4(kto,pnu,pnu,am)
7120 CALL
filhep(0,1,16*isgn,nps,nps,0,0,pnu,am,.true.)
7123 CALL
tralo4(kto,pkk,pkk,am)
7124 CALL
filhep(0,1,-321*isgn,nps,nps,0,0,pkk,am,.true.)
7130 SUBROUTINE dwluks(KTO,ISGN,PNU,PKS,PKK,PPI,JKST)
7131 COMMON / taukle / bra1,brk0,brk0b,brks
7132 REAL*4 bra1,brk0,brk0b,brks
7142 REAL pnu(4),pks(4),pkk(4),ppi(4)
7152 CALL
tralo4(kto,pnu,pnu,am)
7153 CALL
filhep(0,1,16*isgn,nps,nps,0,0,pnu,am,.true.)
7156 CALL
tralo4(kto,pks,pks,am)
7157 CALL
filhep(0,1,-323*isgn,nps,nps,0,0,pks,am,.true.)
7165 CALL
tralo4(kto,ppi,ppi,am)
7166 CALL
filhep(0,1,-211*isgn,-1,-1,0,0,ppi,am,.true.)
7169 IF (isgn.EQ.-1) bran=brk0
7172 IF(xio.GT.bran)
THEN
7178 CALL
tralo4(kto,pkk,pkk,am)
7179 CALL
filhep(0,1,k0type,-2,-2,0,0,pkk,am,.true.)
7181 ELSE IF(jkst.EQ.20)
THEN
7186 CALL
tralo4(kto,ppi,ppi,am)
7187 CALL
filhep(0,1,111,-1,-1,0,0,ppi,am,.true.)
7190 CALL
tralo4(kto,pkk,pkk,am)
7191 CALL
filhep(0,1,-321*isgn,-2,-2,0,0,pkk,am,.true.)
7199 SUBROUTINE dwlumu(KTO,ISGN,PNU,PWB,PMU,PNM)
7209 REAL pnu(4),pwb(4),pmu(4),pnm(4)
7219 CALL
tralo4(kto,pnu,pnu,am)
7220 CALL
filhep(0,1,16*isgn,nps,nps,0,0,pnu,am,.true.)
7223 CALL
tralo4(kto,pwb,pwb,am)
7227 CALL
tralo4(kto,pmu,pmu,am)
7228 CALL
filhep(0,1,13*isgn,nps,nps,0,0,pmu,am,.false.)
7231 CALL
tralo4(kto,pnm,pnm,am)
7232 CALL
filhep(0,1,-14*isgn,nps,nps,0,0,pnm,am,.true.)
7238 SUBROUTINE dwluph(KTO,PHOT)
7251 IF (phot(4).LE.0.0)
RETURN
7254 IF((kto.EQ. 1).OR.(kto.EQ.11))
THEN
7261 IF(ktos.GT.10) ktos=ktos-10
7263 CALL
tralo4(ktos,phot,phot,am)
7264 CALL
filhep(0,1,22,nps,nps,0,0,phot,0.0,.true.)
7270 SUBROUTINE dwlupi(KTO,ISGN,PPI,PNU)
7290 CALL
tralo4(kto,pnu,pnu,am)
7291 CALL
filhep(0,1,16*isgn,nps,nps,0,0,pnu,am,.true.)
7294 CALL
tralo4(kto,ppi,ppi,am)
7295 CALL
filhep(0,1,-211*isgn,nps,nps,0,0,ppi,am,.true.)
7301 SUBROUTINE dwluro(KTO,ISGN,PNU,PRHO,PIC,PIZ)
7311 REAL pnu(4),prho(4),pic(4),piz(4)
7321 CALL
tralo4(kto,pnu,pnu,am)
7322 CALL
filhep(0,1,16*isgn,nps,nps,0,0,pnu,am,.true.)
7325 CALL
tralo4(kto,prho,prho,am)
7326 CALL
filhep(0,2,-213*isgn,nps,nps,0,0,prho,am,.true.)
7329 CALL
tralo4(kto,pic,pic,am)
7330 CALL
filhep(0,1,-211*isgn,-1,-1,0,0,pic,am,.true.)
7333 CALL
tralo4(kto,piz,piz,am)
7334 CALL
filhep(0,1,111,-2,-2,0,0,piz,am,.true.)
7342 SUBROUTINE dwrph(KTO,PHX)
7346 IMPLICIT REAL*8 (
a-h,o-
z)
7357 IF (qhot(4).GT.1.
e-5) CALL
dwluph(kto,qhot)
7370 CHARACTER*8 title,versqq
7375 parameter(nnq=1000000)
7377 dimension lq(nnq),iq(nnq),q(nnq)
7378 equivalence(q(1),iq(1),lq(9),jstruc(8))
7379 COMMON /quest/iquest(100)
7380 COMMON /xqstor/ixevt,ifence(16),jgeev,jstruc(99),jrefer(100),
7383 common/mzioall/iogenf
7386 common/infonew/irdate,irtime
7388 common/cfread/space(5000)
7389 common/mykeys/ievar,if5cc,ineut,iinte,iferm,iflat,icoun,
7390 & refix,imudo,ikat1,ikat2,ikat3,ikat4,ikat5,ikat6,
7391 & inevt,ijak1,ijak2,iitdk,rptau,rxk0d,ntgr,idimuon,iglu,
7392 & iqden,lome(2),ifiles,iccha,iseed,idsubs,ionem,ehac,ipsel,
7399 +
'@(#)JETTA 1.02/13 15/01/97 23.59.31 C: 21/05/97 10.31.11'/
7401 IF (jgeev.EQ.0)
RETURN
7402 CALL mzbook(ixevt,jgenf,jgeev,-1,
'GENF',1,1,7,iogenf,0)
7420 CALL uctoh(
title,ititle,4,8)
7421 iq(jgenf+6)=ititle(1)
7422 iq(jgenf+7)=ititle(2)
7423 CALL mzbook(ixevt,jgecr,jgenf,-1,
'GECR',0,0,31,3,0)
7469 common/cfread/space(5000)
7470 common/mykeys/ievar,if5cc,ineut,iinte,iferm,iflat,icoun,
7471 & refix,imudo,ikat1,ikat2,ikat3,ikat4,ikat5,ikat6,
7472 & inevt,ijak1,ijak2,iitdk,rptau,rxk0d,ntgr,idimuon,iglu,
7473 & iqden,lome(2),ifiles,iccha,iseed,idsubs,ionem,ehac,ipsel,
7482 REAL*4 f,eci,ptr,cs,sn,
phi,ferm,fnuc,tmpx,tmpy,the
7488 tmpx=
rndmm(iseed)*ferm
7491 IF (
sqrt(tmpx).GT.tmpy)
THEN
7500 ptr =
sqrt(eci*fnuc*2.)
7502 cs = 2.*
rndmm(iseed)-1.
7516 SUBROUTINE filhep(N,IST,ID,JMO1,JMO2,JDA1,JDA2,P4,PINV,PHFLAG)
7526 parameter(nmxhep=2000)
7528 DOUBLE PRECISION phep,vhep
7529 common/
hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
7530 &jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
7534 common/phoqed/qedrad(nmxhep)
7546 ELSE IF (
n.GT.0)
THEN
7557 IF ((ihep.LE.0).OR.(ihep.GT.nmxhep))
RETURN
7564 IF(jmo1.LT.0)jmohep(1,ihep)=jmohep(1,ihep)+ihep
7566 IF(jmo2.LT.0)jmohep(2,ihep)=jmohep(2,ihep)+ihep
7581 DO ip=jmohep(1,ihep),jmohep(2,ihep)
7585 IF(isthep(ip).EQ.1)isthep(ip)=2
7588 IF(jdahep(1,ip).EQ.0)
THEN
7592 jdahep(2,ip)=max(ihep,jdahep(2,ip))
7607 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
7608 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
7609 COMMON /linteg/ ntot,npass
7614 flgint=20./9.*parl(25)/pi*(
x/
z)**2*(1.-
x/
z)/
z*xpq(0)
7624 SUBROUTINE flintg(CFLQ,CFLG,CFLM)
7629 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
7630 COMMON /linteg/ ntot,npass
7633 lqcd=
mod(lst(11),10)
7634 ltm=
mod(lst(11)/10,10)
7683 SUBROUTINE flipol(FLQ,FLG,FLM)
7688 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
7689 COMMON /flgrid/ nfx,nfq,xr(2),qr(2),flqt(41,16),flgt(41,16),
7691 DATA nout/0/,nwarn/10/
7693 lqcd=
mod(lst(11),10)
7694 ltm=
mod(lst(11)/10,10)
7700 IF(qr(1).GT.qr(2))
RETURN
7701 IF(
x.LT.xr(1).OR.
x.GT.xr(2).OR.
7702 +q2.LT.qr(1).OR.q2.GT.qr(2))
THEN
7704 IF(lst(2).GE.0)
THEN
7706 IF(lst(3).GE.1.AND.nout.LE.nwarn)
WRITE(6,10000)
x,q2,nwarn
7708 IF(
x.LT.xr(1)) xp=xr(1)
7709 IF(
x.GT.xr(2)) xp=xr(2)
7710 IF(q2.LT.qr(1)) q2p=qr(1)
7711 IF(q2.GT.qr(2)) q2p=qr(2)
7714 ix=(alog10(xp)-alog10(xr(1)))/
7715 &(alog10(xr(2))-alog10(xr(1)))*(nfx-1)+1
7716 iq=(alog10(q2p)-alog10(qr(1)))/
7717 &(alog10(qr(2))-alog10(qr(1)))*(nfq-1)+1
7720 q2l=10**(alog10(qr(1))+(alog10(qr(2))-alog10(qr(1)))*
7722 q2h=10**(alog10(qr(1))+(alog10(qr(2))-alog10(qr(1)))*
7724 xl=10**(alog10(xr(1))+(alog10(xr(2))-alog10(xr(1)))*
7726 xh=10**(alog10(xr(1))+(alog10(xr(2))-alog10(xr(1)))*
7728 qd=(q2p-q2l)/(q2h-q2l)
7732 x1p=(flqt(ix+1,iq)-flqt(ix,iq))*xd+flqt(ix,iq)
7733 x2p=(flqt(ix+1,iq+1)-flqt(ix,iq+1))*xd+flqt(ix,iq+1)
7734 flq=(x2p-x1p)*qd+x1p
7735 x1p=(flgt(ix+1,iq)-flgt(ix,iq))*xd+flgt(ix,iq)
7736 x2p=(flgt(ix+1,iq+1)-flgt(ix,iq+1))*xd+flgt(ix,iq+1)
7737 flg=(x2p-x1p)*qd+x1p
7740 x1p=(flmt(ix+1,iq)-flmt(ix,iq))*xd+flmt(ix,iq)
7741 x2p=(flmt(ix+1,iq+1)-flmt(ix,iq+1))*xd+flmt(ix,iq+1)
7742 flm=(x2p-x1p)*qd+x1p
7746 10000
FORMAT(
' WARNING: X=',f7.4,
' OR Q2=',f6.1,
' OUTSIDE GRID,',
7747 &
' FOR FL INTERPOLATION',/,10
x,
'VALUE ON GRID LIMIT USED.',
7748 &
' ONLY FIRST',i5,
' WARNINGS PRINTED.',/)
7760 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
7761 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
7762 COMMON /linteg/ ntot,npass
7768 DO 10 i=-lst(12),lst(12)
7788 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
7789 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
7790 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
7791 COMMON /linteg/ ntot,npass
7792 COMMON /flgrid/ nfx,nfq,xr(2),qr(2),flqt(41,16),flgt(41,16),
7796 lqcd=
mod(lst(11),10)
7797 ltm=
mod(lst(11)/10,10)
7799 IF(lst(3).GE.3)
WRITE(6,10000) lst(11),lqcd,ltm,lht
7800 IF(lqcd.LT.1.AND.ltm.LT.1)
RETURN
7811 x=10**(alog10(xr(1))+(alog10(xr(2))-alog10(xr(1)))*(ix-1)/(nfx-
7814 IF(qr(1).GT.qr(2)) goto 60
7817 q2=10**(alog10(qr(1))+(alog10(qr(2))-alog10(qr(1)))* (iq-1)/
7820 IF(q2.GT.parl(21)) lq=lq+1
7822 IF(
y.LT.0.0.OR.
y.GT.1.0) lq=lq+1
7871 IF(lst(3).GE.3)
WRITE(6,10100)
t2-
t1
7874 10000
FORMAT(
' INITIALISATION FOR FL; QCD, TARGET MASS, HIGHER TWIST: ',
7875 +/,
' LST(11) =',i5,
' --> LQCD, LTM, LHT =',3i3)
7876 10100
FORMAT(
' FL INTEGRATIONS PERFORMED IF LQCD=1 AND/OR LTM=1, ',
7877 +
'RESULTS ON GRID.'/,
' TIME FOR FL INTEGRATIONS IS ',f7.1,
' SEC.')
7890 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
7891 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
7892 COMMON /linteg/ ntot,npass
7898 DO 10 i=-lst(12),lst(12)
7912 common/ntupl10/ nutype,iparent,eparent,xdecay,ydecay,zdecay,
7913 + pxpar,pypar,pzpar,xdet,ydet,xl,pxnu,pynu,pznu,
7916 common/ludat3/mdcy(500,3),mdme(2000,2),brat(2000), kfdp(2000,5)
7917 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
7925 IF (nuforce.LE.50)
THEN
7932 bratkp(io-360)=brat(io)
7943 bratk0(io-957)=brat(io)
7957 ema=max(edeckp,edeck0)
7964 brat(io)=brat(io)*e1/edeckp
7969 brat(io)=brat(io)*e2/edeck0
7976 IF (isfirst.EQ.0)
THEN
7978 WRITE(*,*)
' +++IMPORTANT!! GBEAM ENHANCED MODE:'
7979 WRITE(*,*)
' +++STATISTICAL AMPLIFICATION OF'
7980 WRITE(*,*)
' +++NEUTRINOS OF TYPE ',nuforce
7981 WRITE(*,*)
' +++BY FACTOR ',xfact
7986 IF (iparent.EQ.9)
THEN
7988 ELSEIF(iparent.EQ.8)
THEN
7990 ELSEIF(iparent.EQ.11)
THEN
7992 ELSEIF(iparent.EQ.12)
THEN
7994 ELSEIF(iparent.EQ.5)
THEN
7996 ELSEIF(iparent.EQ.6)
THEN
7998 ELSEIF(iparent.EQ.10)
THEN
8001 WRITE(*,*)
'WARNING: UNKNOWN GEANT PARENT ID=',iparent
8005 IF (nuforce.EQ.51)
THEN
8007 ELSEIF(nuforce.EQ.52)
THEN
8009 ELSEIF(nuforce.EQ.49)
THEN
8011 ELSEIF(nuforce.EQ.50)
THEN
8025 p(1,4)=
sqrt(
p(1,1)**2+
p(1,2)**2+
p(1,3)**2+
p(1,5)**2)
8034 IF (k(i,2).EQ.luforce)
THEN
8036 tmpxdet=tmpxl*
p(i,1)/
p(i,3)+xdecay
8037 tmpydet=tmpxl*
p(i,2)/
p(i,3)+ydecay
8039 IF (abs(tmpxdet).GT.detx.OR.abs(tmpydet).GT.dety) goto 10
8053 brat(io)=bratk0(io-957)
8057 brat(io)=bratkp(io-360)
8065 FUNCTION form1(MNUM,QQ,S1,SDWA)
8076 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
8077 + ,ampiz,ampi,amro,gamro,ama1,gama1
8078 + ,amk,amkz,amkst,gamkst
8080 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
8081 + ,ampiz,ampi,amro,gamro,ama1,gama1
8082 + ,amk,amkz,amkst,gamkst
8083 wigner(
a,b,c)= cmplx(1.0,0.0)/cmplx(
a-b**2,b*c)
8088 ELSEIF (mnum.EQ.1)
THEN
8093 ELSEIF (mnum.EQ.2)
THEN
8098 ELSEIF (mnum.EQ.3)
THEN
8103 ELSEIF (mnum.EQ.4)
THEN
8109 ELSEIF (mnum.EQ.5)
THEN
8114 ELSEIF (mnum.EQ.6)
THEN
8116 ELSEIF (mnum.EQ.7)
THEN
8125 FUNCTION form2(MNUM,QQ,S1,SDWA)
8136 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
8137 + ,ampiz,ampi,amro,gamro,ama1,gama1
8138 + ,amk,amkz,amkst,gamkst
8140 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
8141 + ,ampiz,ampi,amro,gamro,ama1,gama1
8142 + ,amk,amkz,amkst,gamkst
8143 wigner(
a,b,c)= cmplx(1.0,0.0)/cmplx(
a-b**2,b*c)
8148 ELSEIF (mnum.EQ.1)
THEN
8152 ELSEIF (mnum.EQ.2)
THEN
8156 ELSEIF (mnum.EQ.3)
THEN
8160 ELSEIF (mnum.EQ.4)
THEN
8166 ELSEIF (mnum.EQ.5)
THEN
8173 ELSEIF (mnum.EQ.6)
THEN
8178 ELSEIF (mnum.EQ.7)
THEN
8187 FUNCTION form3(MNUM,QQ,S1,SDWA)
8197 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
8198 + ,ampiz,ampi,amro,gamro,ama1,gama1
8199 + ,amk,amkz,amkst,gamkst
8201 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
8202 + ,ampiz,ampi,amro,gamro,ama1,gama1
8203 + ,amk,amkz,amkst,gamkst
8215 FUNCTION form4(MNUM,QQ,S1,S2,S3)
8223 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
8224 + ,ampiz,ampi,amro,gamro,ama1,gama1
8225 + ,amk,amkz,amkst,gamkst
8227 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
8228 + ,ampiz,ampi,amro,gamro,ama1,gama1
8229 + ,amk,amkz,amkst,gamkst
8232 wigner(
a,b,c)=cmplx(1.0,0.0) /cmplx(
a-b**2,b*c)
8245 IF (
s.GT.(xm1+xm2)**2)
THEN
8246 qs=
sqrt(abs((
s -(xm1+xm2)**2)*(
s -(xm1-xm2)**2)))/
sqrt(
s)
8247 qm=
sqrt(abs((m**2-(xm1+xm2)**2)*(m**2-(xm1-xm2)**2)))/m
8249 gs=g*(m/w)**2*(qs/qm)**5
8254 form4=g1*g2*fpip/amro**4/ampip**2
8255 + *ampip**2*wigner(qq,ampip,gamx)
8256 + *( s1*(s2-s3)*
fpikm(
sqrt(s1),ampiz,ampiz)
8257 + +s2*(s1-s3)*
fpikm(
sqrt(s2),ampiz,ampiz) )
8258 ELSEIF (mnum.EQ.1)
THEN
8270 IF (
s.GT.(xm1+xm2)**2)
THEN
8271 qs=
sqrt(abs((
s -(xm1+xm2)**2)*(
s -(xm1-xm2)**2)))/
sqrt(
s)
8272 qm=
sqrt(abs((m**2-(xm1+xm2)**2)*(m**2-(xm1-xm2)**2)))/m
8274 gs=g*(m/w)**2*(qs/qm)**5
8279 form4=g1*g2*fpip/amro**4/ampip**2
8280 + *ampip**2*wigner(qq,ampip,gamx)
8281 + *( s1*(s2-s3)*
fpikm(
sqrt(s1),ampiz,ampiz)
8282 + +s2*(s1-s3)*
fpikm(
sqrt(s2),ampiz,ampiz) )
8284 form4=cmplx(0.0,0.0)
8287 form4=cmplx(0.0,0.0)
8292 FUNCTION form5(MNUM,QQ,S1,S2)
8301 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
8302 + ,ampiz,ampi,amro,gamro,ama1,gama1
8303 + ,amk,amkz,amkst,gamkst
8305 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
8306 + ,ampiz,ampi,amro,gamro,ama1,gama1
8307 + ,amk,amkz,amkst,gamkst
8309 wigner(
a,b,c)=cmplx(1.0,0.0)/cmplx(
a-b**2,b*c)
8313 ELSEIF (mnum.EQ.1)
THEN
8317 + ampi,ampi) +elpha*
bwigm(s1,amkst,gamkst,ampi,amk))
8318 ELSEIF (mnum.EQ.2)
THEN
8322 + ampi,ampi) +elpha*
bwigm(s1,amkst,gamkst,ampi,amk))
8323 ELSEIF (mnum.EQ.3)
THEN
8326 ELSEIF (mnum.EQ.4)
THEN
8329 ELSEIF (mnum.EQ.5)
THEN
8332 form5=
bwigm(qq,amkst,gamkst,ampi,amk)/(1+elpha)
8334 + +elpha*
bwigm(s2,amkst,gamkst,ampi,amk))
8335 ELSEIF (mnum.EQ.6)
THEN
8338 form5=
bwigm(qq,amkst,gamkst,ampi,amkz)/(1+elpha)
8340 + +elpha*
bwigm(s1,amkst,gamkst,ampi,amk))
8341 ELSEIF (mnum.EQ.7)
THEN
8349 FUNCTION formom(XMAA,XMOM)
8354 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
8355 * ,ampiz,ampi,amro,gamro,ama1,gama1
8356 * ,amk,amkz,amkst,gamkst
8358 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
8359 * ,ampiz,ampi,amro,gamro,ama1,gama1
8360 * ,amk,amkz,amkst,gamkst
8361 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
8362 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
8363 COMMON /testa1/ keya1
8367 bwign(xm,am,
gamma)=1./cmplx(xm**2-am**2,
gamma*am)
8378 fqed =
sqrt(4.0*3.1415926535/137.03604)
8379 formom=fqed*fro**2/
sqrt(2.0)*gcoup**2*bwign(xmom,amom,gamom)
8380 $ *(bwign(xmaa,amro,gamro)+elpha*bwign(xmaa,amrop,gamrop))
8381 $ *(bwign( 0.0,amro,gamro)+elpha*bwign( 0.0,amrop,gamrop))
8386 COMPLEX FUNCTION fpik(W)
8391 REAL rom,rog,rom1,rog1,beta1,pi,pim,
s,w
8396 IF (
init.EQ.0 )
THEN
8415 COMPLEX FUNCTION fpikm(W,XM1,XM2)
8420 REAL rom,rog,rom1,rog1,beta1,pi,pim,
s,w
8425 IF (
init.EQ.0 )
THEN
8444 COMPLEX FUNCTION fpikmd(W,XM1,XM2)
8449 REAL rom,rog,rom1,rog1,pi,pim,
s,w
8454 IF (
init.EQ.0 )
THEN
8471 + +
bwigm(
s,rom2,rog2,xm1,xm2))
8478 COMPLEX FUNCTION fpikmk(W,XM1,XM2)
8483 REAL rom,rog,rom1,rog1,beta1,pi,pim,
s,w
8488 IF (
init.EQ.0 )
THEN
8520 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
8521 * ,ampiz,ampi,amro,gamro,ama1,gama1
8522 * ,amk,amkz,amkst,gamkst
8524 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
8525 * ,ampiz,ampi,amro,gamro,ama1,gama1
8526 * ,amk,amkz,amkst,gamkst
8543 parameter(nnq=1000000)
8545 dimension lq(nnq),iq(nnq),q(nnq)
8546 equivalence(q(1),iq(1),lq(9),jstruc(8))
8547 COMMON /quest/iquest(100)
8548 COMMON /xqstor/ixevt,ifence(16),jgeev,jstruc(99),jrefer(100),
8551 common/mzioall/iogenf
8555 CALL fzendo(lunfz,
'TX')
8569 parameter(nnq=1000000)
8571 dimension lq(nnq),iq(nnq),q(nnq)
8572 equivalence(q(1),iq(1),lq(9),jstruc(8))
8573 COMMON /quest/iquest(100)
8574 COMMON /xqstor/ixevt,ifence(16),jgeev,jstruc(99),jrefer(100),
8577 common/mzioall/iogenf
8580 common/infonew/irdate,irtime
8585 CALL datime(irdate,irtime)
8593 CALL mzstor(ixstor,
'/XQSTOR/',
'.',ifence,jgeev,jrefer(1),
8594 + div12(1),div12(nlim),div12(nnq))
8598 CALL mzdiv(ixstor,ixevt,
'EVT_DIV',ndiv,ndivm,
'.')
8599 CALL dzveri(
'After init.',ixevt,
'CLSU')
8601 CALL
fzopn(
'jetta.rfz')
8602 CALL fzrun(lunfz,99999,0,0)
8607 SUBROUTINE fzopn(CHNAME)
8615 parameter(nnq=1000000)
8617 dimension lq(nnq),iq(nnq),q(nnq)
8618 equivalence(q(1),iq(1),lq(9),jstruc(8))
8619 COMMON /quest/iquest(100)
8620 COMMON /xqstor/ixevt,ifence(16),jgeev,jstruc(99),jrefer(100),
8623 common/mzioall/iogenf
8627 CHARACTER chname*(*)
8633 IF (chname(1:3).EQ.
'exa')
THEN
8634 chname =
'/dev/rmt0'
8639 CALL cfopen(lunptr,med,8100,
'w',0,chname,istat)
8640 IF (istat.NE.0)
THEN
8641 WRITE(lpunit,10020) istat,lunfz
8645 CALL fzfile(lunfz,8100,opt)
8646 IF (iquest(1).NE.0)
THEN
8647 WRITE (lpunit,10010) iquest(1),lunfz
8650 10010
FORMAT (//
' +++FILOPN - fatal error no. =',i5,
' returned from',
8651 +
' FZFILE, LUN = ',i5,
' ++++++++')
8652 10020
FORMAT (//
' +++FILOPN - fatal error no. =',i5,
' returned from',
8653 +
' CFOPEN, LUN = ',i5,
' ++++++++')
8664 SUBROUTINE gadap(A0,B0,F,EPS,SUM)
8681 common/gadap1/ num,ifu
8683 dimension
a(300),b(300),
f1(300),
f2(300),
f3(300),
s(300),
n(300)
8684 10000
FORMAT(16h
gadap:i too big)
8685 dsum(f1f,f2f,f3f,aa,bb)=5./18.*(bb-aa)*(f1f+1.6*f2f+f3f)
8686 IF(eps.LT.1.0
e-8) eps=1.0
e-8
8694 f1(1)=
f(0.5*(1+c)*a0+0.5*(1-c)*b0)
8695 f2(1)=
f(0.5*(a0+b0))
8696 f3(1)=
f(0.5*(1-c)*a0+0.5*(1+c)*b0)
8703 a(i+1)=
a(i)+c*(b(i)-
a(i))
8705 a(i+2)=
a(i)+b(i)-
a(i+1)
8709 w1=
a(i)+(b(i)-
a(i))/5.
8710 u2=2.*w1-(
a(i)+
a(i+2))/2.
8711 f1(i+1)=
f(
a(i)+b(i)-w1)
8713 f3(i+1)=
f(b(i)-
a(i+2)+w1)
8716 f3(i+2)=
f(b(i+2)+
a(i+2)-u2)
8717 f1(i+3)=
f(
a(i)+
a(i+2)-w1)
8721 IF(ifu.GT.5000) goto 40
8725 ss=
s(i+1)+
s(i+2)+
s(i+3)
8729 IF(abs(sold-ss).GT.eps*(1.+abs(ss))/2.) goto 10
8738 IF(
n(l).NE.0) goto 10
8750 SUBROUTINE gadap2(A0,B0,FL,FU,F,EPS,SUM)
8771 common/gadap1/ num,ifu
8773 dimension
a(300),b(300),
f1(300),
f2(300),
f3(300),
s(300),
n(300)
8774 10000
FORMAT(16h
gadap:i too big)
8775 dsum(f1f,f2f,f3f,aa,bb)=5./18.*(bb-aa)*(f1f+1.6*f2f+f3f)
8776 IF(eps.LT.1.0
e-8) eps=1.0
e-8
8784 x=0.5*(1+c)*a0+0.5*(1-c)*b0
8792 x=0.5*(1-c)*a0+0.5*(1+c)*b0
8802 a(i+1)=
a(i)+c*(b(i)-
a(i))
8804 a(i+2)=
a(i)+b(i)-
a(i+1)
8808 w1=
a(i)+(b(i)-
a(i))/5.
8809 u2=2.*w1-(
a(i)+
a(i+2))/2.
8838 IF(ifu.GT.5000) goto 40
8842 ss=
s(i+1)+
s(i+2)+
s(i+3)
8846 IF(abs(sold-ss).GT.eps*(1.+abs(ss))/2.) goto 10
8855 IF(
n(l).NE.0) goto 10
8868 FUNCTION gadapf(X,A0,B0,F,EPS)
8869 common/gadap1/ num,ifu
8871 dimension
a(300),b(300),
f1(300),
f2(300),
f3(300),
s(300),
n(300)
8872 10000
FORMAT(16h
gadap:i too big)
8873 dsum(f1f,f2f,f3f,aa,bb)=5./18.*(bb-aa)*(f1f+1.6*f2f+f3f)
8874 IF(eps.LT.1.0
e-8) eps=1.0
e-8
8882 f1(1)=
f(
x,0.5*(1+c)*a0+0.5*(1-c)*b0)
8883 f2(1)=
f(
x,0.5*(a0+b0))
8884 f3(1)=
f(
x,0.5*(1-c)*a0+0.5*(1+c)*b0)
8891 a(i+1)=
a(i)+c*(b(i)-
a(i))
8893 a(i+2)=
a(i)+b(i)-
a(i+1)
8897 w1=
a(i)+(b(i)-
a(i))/5.
8898 u2=2.*w1-(
a(i)+
a(i+2))/2.
8899 f1(i+1)=
f(
x,
a(i)+b(i)-w1)
8901 f3(i+1)=
f(
x,b(i)-
a(i+2)+w1)
8904 f3(i+2)=
f(
x,b(i+2)+
a(i+2)-u2)
8905 f1(i+3)=
f(
x,
a(i)+
a(i+2)-w1)
8909 IF(ifu.GT.5000) goto 40
8913 ss=
s(i+1)+
s(i+2)+
s(i+3)
8917 IF(abs(sold-ss).GT.eps*(1.+abs(ss))/2.) goto 10
8926 IF(
n(l).NE.0) goto 10
8944 COMMON /contro/ binit,lunb,npneut,npanti,cpnorm,xpsour,sigdiv
8945 COMMON /fluxes/ fluxd(80000),
weight(8),specd(800),specn(800)
8946 COMMON /input/ iall(80000),ncount(8)
8964 READ(
unit=lunb,fmt=101,
end=10) (ibuf(j),j=1,16)
8978 ncount(i) = ncount(i)+iall(ii)
8984 cneut = cpnorm/1.e3/float(npneut)
8985 canti = cpnorm/1.e3/float(npanti)
8987 fluxd(i) = cneut*float(iall(i))
8988 fluxd(40000+i) = canti*float(iall(40000+i))
8994 weight(i) = cneut*ncount(i)
8995 weight(4+i) = canti*ncount(4+i)
9004 CALL vzero(specd,800)
9005 CALL vzero(specn,800)
9010 jj = (i-1)*10000+j+(k-1)*100
9011 specd(ii) = specd(ii)+fluxd(jj)
9012 specn(ii) = specd(ii)
9019 specn(ii) = specn(ii)+specn(ii-1)
9032 SUBROUTINE gbspec(BEAM,IFLAV,RADIUS,SPEC)
9035 COMMON /contro/ binit,lunb,npneut,npanti,cpnorm,xpsour,sigdiv
9036 COMMON /fluxes/ fluxd(80000),
weight(8),specd(800),specn(800)
9037 COMMON /input/ iall(80000),ncount(8)
9045 common/maxspec/rmaxspec,rintspec
9047 IF(.NOT.binit) CALL
gbinit
9049 IF(beam.EQ.
'NEUT')
THEN
9051 ELSEIF(beam.EQ.
'ANTI')
THEN
9057 IF(iflav.LT.1.OR.iflav.GT.4) goto 10
9058 IF(radius.LE.0.0.OR.radius.GE.300.0) goto 10
9061 CALL vzero(spec,100)
9062 rad2 = radius**2/900.+1.
9064 frac = rad2-float(iradiu)*900.
9067 ip = (iflav-1)*10000+i+(j-1)*100
9068 spec(i) = spec(i)+fluxd(ip)
9070 ii = (iflav-1)*10000+i+(iradiu-1)*100
9071 IF(frac.GT.0.0) spec(i) = spec(i)+frac*fluxd(ii)
9076 rmaxspec=max(rmaxspec,spec(i))
9077 rintspec=rintspec+spec(i)
9084 10000
FORMAT(1
x,
' GBSPEC: ERROR IN INPUT VARIABLES!')
9102 SUBROUTINE gentable(LFILE,LEPIN,ENERGY_FIX,PPZ,INTERACTION)
9105 parameter(icento=100)
9109 parameter(lux_level=4)
9110 INTEGER*4 jtau(100),jpri(100),jstro(100)
9112 common/jettagl/jtau,jpri,jstro
9113 common/ntupla/ftuple,isfirst
9114 common/beam/spec(icento)
9115 COMMON /maxspec/rmaxspec,rintspec
9116 common/sav/xminsav(icento),xmaxsav(icento),yminsav(icento),
9117 & ymaxsav(icento),q2minsav(icento),q2maxsav(icento),
9118 & w2minsav(icento),w2maxsav(icento),parimax(icento),
9119 & ppsave(icento,3,4,5),paricor(icento),
index,sigmasav(icento),
9123 common/cfread/space(5000)
9124 common/mykeys/ievar,if5cc,ineut,iinte,iferm,iflat,icoun,
9125 & refix,imudo,ikat1,ikat2,ikat3,ikat4,ikat5,ikat6,
9126 & inevt,ijak1,ijak2,iitdk,rptau,rxk0d,ntgr,idimuon,iglu,
9127 & iqden,lome(2),ifiles,iccha,iseed,idsubs,ionem,ehac,ipsel,
9132 REAL vect(3),gkin(3),g4mes(4)
9133 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
9134 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
9135 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
9136 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
9141 + mestype,g4mes,neuforce,imode)
9142 IF (lst(17).EQ.0)
THEN
9143 CALL
linit(lfile,lepin,energy_fix,ppz,interaction)
9144 WRITE(55,*)energy_fix,parl(23),
xmin,
xmax,ymin,ymax,q2min,q2max,1.
9156 CALL
linit(lfile,lepin,ene,ppz,interaction)
9159 parimax(i)=pari(lst(23))*1.5
9168 sigmasav(i)=parl(23)
9169 xmsigma=max(parl(23),xmsigma)
9172 10 ppsave(i,3,ia,ja)=psave(3,ia,ja)
9174 IF (lst(37).EQ.0) rmaxspec=max(rmaxspec,spec(i))
9175 WRITE(*,*)
'X-SECTION AT',ene,
' GEV=',parl(23),
9176 +
'PB BEAM WEIGHTED:',spec(i)
9177 WRITE(55,*)ene,parl(23),
xmin,
xmax,ymin,
9178 + ymax,q2min,q2max,spec(i),pari(lst(23))
9181 CALL
linit(lfile,lepin,100.,ppz,interaction)
9197 SUBROUTINE gethneu(IPNUM,NEUTYPE,VECT,GKIN,
9198 + mestype,g4mes,neuforce,imode)
9213 CHARACTER*80 filname
9214 CHARACTER chvar(16)*8
9216 dimension
vect(3),gkin(3),yarr(100)
9217 dimension g4mes(4),ihis(4)
9219 common/ntupl10/ nutype,iparent,eparent,xdecay,ydecay,zdecay,
9220 + pxpar,pypar,pzpar,xdet,ydet,xl,pxnu,pynu,pznu,
9222 common/runcom/imodeold,ifiles,irun
9224 DATA ihis/3001,4001,1001,2001/
9225 DATA chvar/
'NUTYPE',
'IPARENT',
'EPARENT',
'XDECAY ',
9226 +
'YDECAY',
'ZDECAY',
'PXPAR',
'PYPAR',
9227 +
'PZPAR',
'XDET',
'YDET',
'XL',
9228 +
'PXNU',
'PYNU',
'PZNU',
'NPROT'/
9231 IF (imode.EQ.0)
THEN
9249 IF (imode.EQ.2)
THEN
9255 WRITE(filname,1)
'../beam/histos.rz'
9261 CALL hropen(2,
'BDIR',filname,
' ',lrec,istat)
9268 CALL hcdir(
'//BDIR',
' ')
9269 CALL hrin(ihi,9999,0)
9270 CALL hunpak(ihi,yarr,
' ',0)
9273 CALL hispre(yarr,nbin)
9274 IF (istat.NE.0)
THEN
9280 IF (imode.NE.4)
THEN
9283 55
FORMAT(1
x,
'OPENING HISTOS FILE ',
a)
9292 CALL hisran(yarr,nbin,0.,3.,xran)
9294 IF (nutype.EQ.53) nutype=49
9295 IF (nutype.EQ.54) nutype=50
9298 print *,
'ERROR', icount
9303 IF (neuforce.NE.0)
THEN
9332 500
FORMAT(1
x,
'POT=',i10,1
x,
9333 +
'NEUT=',i3 ,1
x,
' x =',e15.9
9341 IF (imode.EQ.4)
THEN
9342 WRITE(*,*)
' END OF NEUTRINO STATISTICS ...REWINDING...'
9343 WRITE(*,*)
' TO CONTINUE, you have to SET IMODE=2'
9357 SUBROUTINE getneu(IPNUM,NEUTYPE,VECT,GKIN,
9358 + mestype,g4mes,neuforce,imode)
9372 CHARACTER*80 filname
9373 CHARACTER chvar(16)*8
9375 dimension
vect(3),gkin(3)
9378 common/ntupl10/ nutype,iparent,eparent,xdecay,ydecay,zdecay,
9379 + pxpar,pypar,pzpar,xdet,ydet,xl,pxnu,pynu,pznu,
9381 common/runcom/imodeold,ifiles,irun
9383 DATA chvar/
'NUTYPE',
'IPARENT',
'EPARENT',
'XDECAY ',
9384 +
'YDECAY',
'ZDECAY',
'PXPAR',
'PYPAR',
9385 +
'PZPAR',
'XDET',
'YDET',
'XL',
9386 +
'PXNU',
'PYNU',
'PZNU',
'NPROT'/
9389 IF (imode.EQ.0)
THEN
9407 IF (imode.EQ.2)
THEN
9419 WRITE(filname,1)irun
9420 1
FORMAT(
'../beam/neutrino',i1,
'.rz')
9421 ELSE IF (irun.LT.100)
THEN
9422 WRITE(filname,2)irun
9423 2
FORMAT(
'../beam/neutrino',i2,
'.rz')
9424 ELSE IF (irun.LT.1000)
THEN
9425 WRITE(filname,3)irun
9426 3
FORMAT(
'../beam/neutrino',i3,
'.rz')
9431 CALL hropen(2,
'BDIR',filname,
'X',lrec,istat)
9433 IF (istat .NE. 0)
THEN
9436 WRITE(filname,1)irun
9438 CALL hropen(2,
'BDIR',filname,
'X',lrec,istat)
9439 IF (istat.NE.0)
THEN
9445 CALL hrin(0, 999, 0)
9447 IF (imode.NE.4)
THEN
9448 WRITE(6,55) imax,filname
9450 55
FORMAT(1
x,
'OPENING ',i8,
' EVENTS FROM FILE ',
a)
9456 CALL hbname(1,
' ',0,
'$CLEAR')
9457 CALL hbname(1,
'XNUMU', nutype,
'$SET:NUTYPE')
9458 CALL hbname(1,
'XNUMU', iparent,
'$SET:IPARENT')
9459 CALL hbname(1,
'XNUMU', eparent,
'$SET:EPARENT')
9460 CALL hbname(1,
'XNUMU', xdecay,
'$SET:XDECAY')
9461 CALL hbname(1,
'XNUMU', ydecay,
'$SET:YDECAY')
9462 CALL hbname(1,
'XNUMU', zdecay,
'$SET:ZDECAY')
9463 CALL hbname(1,
'XNUMU', pxpar,
'$SET:PXPAR')
9464 CALL hbname(1,
'XNUMU', pypar,
'$SET:PYPAR')
9465 CALL hbname(1,
'XNUMU', pzpar,
'$SET:PZPAR')
9466 CALL hbname(1,
'XNUMU', xdet,
'$SET:XDET')
9467 CALL hbname(1,
'XNUMU', ydet,
'$SET:YDET')
9468 CALL hbname(1,
'XNUMU', xl,
'$SET:XL')
9469 CALL hbname(1,
'XNUMU', pxnu,
'$SET:PXNU')
9470 CALL hbname(1,
'XNUMU', pynu,
'$SET:PYNU')
9471 CALL hbname(1,
'XNUMU', pznu,
'$SET:PZNU')
9472 CALL hbname(1,
'XNUMU', nprot,
'$SET:NPROT')
9479 CALL hgntv(1, chvar, 16, icount+1, ierr)
9481 IF (nutype.EQ.53) nutype=49
9482 IF (nutype.EQ.54) nutype=50
9485 print *,
'ERROR', icount
9490 IF (neuforce.NE.0)
THEN
9519 500
FORMAT(1
x,
'POT=',i10,1
x,
9520 +
'NEUT=',i3 ,1
x,
' x =',e15.9
9529 IF(icount.EQ.imax)
THEN
9535 56
FORMAT(1
x,
'CLOSING FILE',1
x,
a)
9540 IF (imode.EQ.4)
THEN
9541 WRITE(*,*)
' END OF NEUTRINO STATISTICS ...REWINDING...'
9542 WRITE(*,*)
' TO CONTINUE, you have to SET IMODE=2'
9554 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
9555 + ,ampiz,ampi,amro,gamro,ama1,gama1
9556 + ,amk,amkz,amkst,gamkst
9558 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
9559 + ,ampiz,ampi,amro,gamro,ama1,gama1
9560 + ,amk,amkz,amkst,gamkst
9562 IF (qkwa.LT.(amro+ampi)**2)
THEN
9563 gfun=4.1*(qkwa-9*ampiz**2)**3 *(1.-3.3*(qkwa-9*ampiz**2)+5.8*
9564 + (qkwa-9*ampiz**2)**2)
9566 gfun=qkwa*(1.623+10.38/qkwa-9.32/qkwa**2+0.65/qkwa**3)
9578 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
9579 * ,ampiz,ampi,amro,gamro,ama1,gama1
9580 * ,amk,amkz,amkst,gamkst
9582 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
9583 * ,ampiz,ampi,amro,gamro,ama1,gama1
9584 * ,amk,amkz,amkst,gamkst
9617 COMMON / qedprm /alfinv,alfpi,xk0
9618 REAL*8 alfinv,alfpi,xk0
9621 pi8 = 4.d0*datan(1.d0)
9622 alfinv = 137.03604d0
9623 alfpi = 1d0/(alfinv*pi8)
9640 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
9641 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
9642 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
9643 + ,ampiz,ampi,amro,gamro,ama1,gama1
9644 + ,amk,amkz,amkst,gamkst
9646 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
9647 + ,ampiz,ampi,amro,gamro,ama1,gama1
9648 + ,amk,amkz,amkst,gamkst
9649 COMMON / taubra / gamprt(30),jlist(30),nchan
9650 COMMON / taukle / bra1,brk0,brk0b,brks
9651 REAL*4 bra1,brk0,brk0b,brks
9652 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
9653 COMMON / mdecomp /idffin(9,nmode),mulpik(nmode)
9655 CHARACTER names(nmode)*31
9674 dimension nopik(6,nmode),npik(nmode)
9684 DATA nopik / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
9685 + -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
9686 + -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
9687 + -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
9688 + -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
9689 + -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
9690 + 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
9691 + -3, 4, 0, 0, 0, 0 /
9695 IF (i.LE.nchan)
THEN
9697 IF(i.EQ. 1) gamprt(i) = 1.00000
9698 IF(i.EQ. 2) gamprt(i) = 0.97980
9699 IF(i.EQ. 3) gamprt(i) = 0.64960
9701 IF(i.EQ. 4) gamprt(i) = 1.3405
9702 IF(i.EQ. 5) gamprt(i) = 1.2
9703 IF(i.EQ. 6) gamprt(i) = 0.0397
9704 IF(i.EQ. 7) gamprt(i) = 0.0696
9706 IF(i.EQ. 8) gamprt(i) = 0.0835
9707 IF(i.EQ. 9) gamprt(i) = 0.0170
9708 IF(i.EQ.10) gamprt(i) = 0.0641
9709 IF(i.EQ.11) gamprt(i) = 0.00286
9710 IF(i.EQ.12) gamprt(i) = 0.0043
9711 IF(i.EQ.13) gamprt(i) = 0.0042
9712 IF(i.EQ.14) gamprt(i) = 0.0061
9713 IF(i.EQ.15) gamprt(i) = 0.0056
9714 IF(i.EQ.16) gamprt(i) = 0.0005
9715 IF(i.EQ.17) gamprt(i) = 0.0059
9716 IF(i.EQ.18) gamprt(i) = 0.0321
9717 IF(i.EQ.19) gamprt(i) = 0.0320
9718 IF(i.EQ.20) gamprt(i) = 0.0110
9719 IF(i.EQ.21) gamprt(i) = 0.0031
9720 IF(i.EQ.22) gamprt(i) = 0.0181
9721 IF(i.EQ. 8) names(i-7)=
' TAU- --> 2PI-, PI0, PI+ '
9722 IF(i.EQ. 9) names(i-7)=
' TAU- --> 3PI0, PI- '
9723 IF(i.EQ.10) names(i-7)=
' TAU- --> 2PI-, PI+, 2PI0 '
9724 IF(i.EQ.11) names(i-7)=
' TAU- --> 3PI-, 2PI+, '
9725 IF(i.EQ.12) names(i-7)=
' TAU- --> 3PI-, 2PI+, PI0 '
9726 IF(i.EQ.13) names(i-7)=
' TAU- --> 2PI-, PI+, 3PI0 '
9727 IF(i.EQ.14) names(i-7)=
' TAU- --> K-, PI-, K+ '
9728 IF(i.EQ.15) names(i-7)=
' TAU- --> K0, PI-, K0B '
9729 IF(i.EQ.16) names(i-7)=
' TAU- --> K-, K0, PI0 '
9730 IF(i.EQ.17) names(i-7)=
' TAU- --> PI0, PI0, K- '
9731 IF(i.EQ.18) names(i-7)=
' TAU- --> K-, PI-, PI+ '
9732 IF(i.EQ.19) names(i-7)=
' TAU- --> PI-, K0B, PI0 '
9733 IF(i.EQ.20) names(i-7)=
' TAU- --> ETA, PI-, PI0 '
9734 IF(i.EQ.21) names(i-7)=
' TAU- --> PI-, PI0, GAM '
9735 IF(i.EQ.22) names(i-7)=
' TAU- --> K-, K0 '
9744 idffin(j,i)=nopik(j,i)
9769 scabib =
sqrt(1.-ccabib**2)
9770 gamel = gfermi**2*amtau**5/(192*pi**3)
9790 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
9791 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
9792 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
9793 + ,ampiz,ampi,amro,gamro,ama1,gama1
9794 + ,amk,amkz,amkst,gamkst
9796 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
9797 + ,ampiz,ampi,amro,gamro,ama1,gama1
9798 + ,amk,amkz,amkst,gamkst
9799 COMMON / taubra / gamprt(30),jlist(30),nchan
9800 COMMON / taukle / bra1,brk0,brk0b,brks
9801 REAL*4 bra1,brk0,brk0b,brks
9802 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
9803 COMMON / mdecomp /idffin(9,nmode),mulpik(nmode)
9805 CHARACTER names(nmode)*31
9824 dimension nopik(6,nmode),npik(nmode)
9834 DATA nopik / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
9835 + -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
9836 + -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
9837 + -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
9838 + -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
9839 + -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
9840 + 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
9841 + -3, 4, 0, 0, 0, 0 /
9845 IF (i.LE.nchan)
THEN
9847 IF(i.EQ. 1) gamprt(i) = 1.00000
9848 IF(i.EQ. 2) gamprt(i) = 0.98001
9849 IF(i.EQ. 3) gamprt(i) = 0.64964
9850 IF(i.EQ. 4) gamprt(i) = 1.39922
9851 IF(i.EQ. 5) gamprt(i) = 0.8432
9852 IF(i.EQ. 6) gamprt(i) = 0.03720
9853 IF(i.EQ. 7) gamprt(i) = 0.08051
9854 IF(i.EQ. 8) gamprt(i) = 0.0835
9855 IF(i.EQ. 9) gamprt(i) = 0.0170
9856 IF(i.EQ.10) gamprt(i) = 0.0641
9857 IF(i.EQ.11) gamprt(i) = 0.0286
9858 IF(i.EQ.12) gamprt(i) = 0.0043
9859 IF(i.EQ.13) gamprt(i) = 0.0042
9860 IF(i.EQ.14) gamprt(i) = 0.01222
9861 IF(i.EQ.15) gamprt(i) = 0.0056
9862 IF(i.EQ.16) gamprt(i) = 0.0005
9863 IF(i.EQ.17) gamprt(i) = 0.0059
9864 IF(i.EQ.18) gamprt(i) = 0.0321
9865 IF(i.EQ.19) gamprt(i) = 0.0320
9866 IF(i.EQ.20) gamprt(i) = 0.0110
9867 IF(i.EQ.21) gamprt(i) = 0.0031
9868 IF(i.EQ.22) gamprt(i) = 0.0181
9869 IF(i.EQ. 8) names(i-7)=
' TAU- --> 2PI-, PI0, PI+ '
9870 IF(i.EQ. 9) names(i-7)=
' TAU- --> 3PI0, PI- '
9871 IF(i.EQ.10) names(i-7)=
' TAU- --> 2PI-, PI+, 2PI0 '
9872 IF(i.EQ.11) names(i-7)=
' TAU- --> 3PI-, 2PI+, '
9873 IF(i.EQ.12) names(i-7)=
' TAU- --> 3PI-, 2PI+, PI0 '
9874 IF(i.EQ.13) names(i-7)=
' TAU- --> 2PI-, PI+, 3PI0 '
9875 IF(i.EQ.14) names(i-7)=
' TAU- --> K-, PI-, K+ '
9876 IF(i.EQ.15) names(i-7)=
' TAU- --> K0, PI-, K0B '
9877 IF(i.EQ.16) names(i-7)=
' TAU- --> K-, K0, PI0 '
9878 IF(i.EQ.17) names(i-7)=
' TAU- --> PI0, PI0, K- '
9879 IF(i.EQ.18) names(i-7)=
' TAU- --> K-, PI-, PI+ '
9880 IF(i.EQ.19) names(i-7)=
' TAU- --> PI-, K0B, PI0 '
9881 IF(i.EQ.20) names(i-7)=
' TAU- --> ETA, PI-, PI0 '
9882 IF(i.EQ.21) names(i-7)=
' TAU- --> PI-, PI0, GAM '
9883 IF(i.EQ.22) names(i-7)=
' TAU- --> K-, K0 '
9892 idffin(j,i)=nopik(j,i)
9917 scabib =
sqrt(1.-ccabib**2)
9918 gamel = gfermi**2*amtau**5/(192*pi**3)
9929 SUBROUTINE jaker(JAK)
9959 COMMON / taubra / gamprt(30),jlist(30),nchan
9960 common/beri/jally,jein
9965 IF(nchan.LE.0.OR.nchan.GT.30) goto 30
9972 IF(rrr.LT.cumul(i)/cumul(nchan)) ji=i
9976 jally(jak)=jally(jak)+1
9979 10000
FORMAT(
' ----- JAKER: WRONG NCHAN')
9997 COMMON /contro/ binit,lunb,npneut,npanti,cpnorm,xpsour,sigdiv
9998 COMMON /fluxes/ fluxd(80000),
weight(8),specd(800),specn(800)
9999 COMMON /input/ iall(80000),ncount(8)
10006 COMMON /polariz/pol(4000,3)
10009 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
10012 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
10017 common/foreficass/ievt
10022 parameter(icento=100)
10026 parameter(lux_level=4)
10027 INTEGER*4 jtau(100),jpri(100),jstro(100)
10028 REAL*4 ftuple(isiz)
10029 common/jettagl/jtau,jpri,jstro
10030 common/ntupla/ftuple,isfirst
10031 common/beam/spec(icento)
10032 COMMON /maxspec/rmaxspec,rintspec
10033 common/sav/xminsav(icento),xmaxsav(icento),yminsav(icento),
10034 & ymaxsav(icento),q2minsav(icento),q2maxsav(icento),
10035 & w2minsav(icento),w2maxsav(icento),parimax(icento),
10036 & ppsave(icento,3,4,5),paricor(icento),
index,sigmasav(icento),
10041 CALL vzero(jtau,100)
10042 CALL vzero(jpri,100)
10043 CALL vzero(jstro,100)
10049 IF(k(ipa2,2).EQ.92) jstro(i)=1
10051 IF (igpa.NE.0)
THEN
10057 IF(k(i,4).EQ.0.AND.k(i,1).LE.10.AND.k(i,3).NE.0.AND. abs(k(i,2)
10058 + ).NE.12.AND.abs(k(i,2)).NE.14.AND. abs(k(i,2)).NE.16)
THEN
10064 ftuple(65)=ftuple(65)+
p(i,4)
10065 ftuple(68)=ftuple(68)+1
10066 IF (icharge.EQ.0) ftuple(71)=ftuple(71)+1
10067 IF (abs(k(i,2)).EQ.11.OR.abs(k(i,2)).EQ.22)
THEN
10069 ftuple(66)=ftuple(66)+
p(i,4)
10070 ftuple(69)=ftuple(69)+1
10071 IF (icharge.EQ.0) ftuple(72)=ftuple(72)+1
10075 IF (abs(k(i,2)).GE.100.and.k(i,1).le.10.and.
10076 + k(i,1).ge.1)
THEN
10078 ftuple(67)=ftuple(67)+
p(i,4)
10079 ftuple(70)=ftuple(70)+1
10080 IF (icharge.EQ.0) ftuple(73)=ftuple(73)+1
10084 IF (ismissed.EQ.0.AND.abs(k(i,2)).NE.13)
THEN
10085 WRITE(*,*)
' MISSED EM/HAD/MU PARTICLE:',k(i,2)
10092 IF (igrandpa.NE.0)
THEN
10150 common/foreficass/ievt
10155 parameter(icento=100)
10159 parameter(lux_level=4)
10160 INTEGER*4 jtau(100),jpri(100),jstro(100)
10161 REAL*4 ftuple(isiz)
10162 common/jettagl/jtau,jpri,jstro
10163 common/ntupla/ftuple,isfirst
10164 common/beam/spec(icento)
10165 COMMON /maxspec/rmaxspec,rintspec
10166 common/sav/xminsav(icento),xmaxsav(icento),yminsav(icento),
10167 & ymaxsav(icento),q2minsav(icento),q2maxsav(icento),
10168 & w2minsav(icento),w2maxsav(icento),parimax(icento),
10169 & ppsave(icento,3,4,5),paricor(icento),
index,sigmasav(icento),
10173 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
10176 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
10179 common/cfread/space(5000)
10180 common/mykeys/ievar,if5cc,ineut,iinte,iferm,iflat,icoun,
10181 & refix,imudo,ikat1,ikat2,ikat3,ikat4,ikat5,ikat6,
10182 & inevt,ijak1,ijak2,iitdk,rptau,rxk0d,ntgr,idimuon,iglu,
10183 & iqden,lome(2),ifiles,iccha,iseed,idsubs,ionem,ehac,ipsel,
10189 parameter(nnq=1000000)
10191 dimension lq(nnq),iq(nnq),q(nnq)
10192 equivalence(q(1),iq(1),lq(9),jstruc(8))
10193 COMMON /quest/iquest(100)
10194 COMMON /xqstor/ixevt,ifence(16),jgeev,jstruc(99),jrefer(100),
10196 COMMON /fzlun/lunfz
10197 common/mzioall/iogenf
10202 REAL*4 vert(maxv,3)
10203 REAL*4 wa59(maxt,9),vec(8)
10204 REAL*4 tmpar(3),vstr(3),pm(3),ph(3)
10207 INTEGER ntbeam(maxv)
10208 INTEGER ipart(maxv,maxt)
10209 INTEGER lpart(maxv,maxt)
10210 INTEGER lstrfrom(maxv,maxt)
10211 INTEGER lstrda(maxv,maxt)
10212 INTEGER ktrk(maxv,maxt)
10213 REAL*4 plab(maxv,maxt,3)
10214 REAL*4 ubuft(maxv,maxt,7)
10216 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
10217 common/sbeam/ pnumber,neutype,
vect(3),gkin(3),mestype,g4mes(4)
10219 INTEGER*4 daluaef(200)
10220 common/dalua/daluaef
10222 CALL vzero(lstrfrom,maxv*maxt)
10223 CALL vzero(lstrda,maxv*maxt)
10227 IF (unouno.EQ.0)
THEN
10248 CALL vzero(daluaef,200)
10252 IF (k(i,2).EQ.92)
THEN
10253 str=
sqrt(
p(i,1)**2+
p(i,2)**2+
p(i,3)**2)
10255 vstr(ib)=
p(i,ib)/str
10260 IF ((k(i,1).LE.10.OR.(k(i,1).GT.10.AND.
10261 + k(i,4).GT.0.AND.v(i,5).NE.0).AND.
p(i,4)
10262 + .GT.emin).OR.i.EQ.4)
THEN
10267 IF((abs(k(i,2)).GT.400.AND.abs(k(i,2)).LT.500)
10268 + .OR.abs(k(i,2)).EQ.4122)
THEN
10270 ftuple(iof1+7)=ftuple(iof1+7)+1
10275 IF (v(i,3).NE.curvz)
THEN
10280 IF (v(i,3).EQ.vert(jj,3))
THEN
10285 IF (isfound.EQ.1)
THEN
10292 vert(nvtx,j)=v(i,j)
10299 IF (iparent.NE.0)
THEN
10304 IF (k(iparent,4).GT.0..AND.
10305 + v(iparent,5).NE.0.AND.k(iparent,1).GT.10)
THEN
10309 iparent=k(iparent,3)
10318 IF (ievt.GE.lome(1).AND.ievt.LE.lome(2))
THEN
10319 WRITE(*,*)
' VERTEX PARENT FOR PARTICLE NUMBER',
10320 + i,
' = ', rent,ipa
10322 ntbeam(nvtx)=iparent
10334 IF (k(i,2).EQ.92) istringa=i
10335 IF ((k(i,1).LE.10.OR.(k(i,1).GT.10.AND.
10336 + k(i,4).GT.0.AND.v(i,5).NE.0)).AND.
p(i,
10337 + 4).GT.emin.OR.i.EQ.4)
THEN
10338 IF (v(i,3).EQ.vert(j,3))
THEN
10344 ktrk(j,ntrv(j))=ntrk
10347 lpart(j,ntrv(j))=k(i,2)
10348 lstrfrom(j,ntrv(j))=jstro(i)
10349 IF (k(i,3).EQ.istringa)
THEN
10350 lstrda(j,ntrv(j))=1
10355 plab(j,ntrv(j),kk)=
p(i,kk)
10358 ubuft(j,ntrv(j),1)=
sqrt(
p(i,1)**2+
p(i,2)**2)
10359 ubuft(j,ntrv(j),2)=
sqrt(
p(i,1)**2+
p(i,2)**2+
p(i,3)**2)
10360 ubuft(j,ntrv(j),3)=
p(i,4)
10361 ppp=ubuft(j,ntrv(j),2)
10365 ubuft(j,ntrv(j),3+kk)=
p(i,kk)/ppp
10369 ubuft(j,ntrv(j),3+kk)=0.
10373 ubuft(j,ntrv(j),7)=0.
10375 IF (k(i,4).NE.0.AND.v(i,5).NE.0)
THEN
10376 IF (
p(i,5).GT.0)
THEN
10377 ubuft(j,ntrv(j),7)=v(i,5)*ppp/
p(i,5)/10.
10379 ubuft(j,ntrv(j),7)=0.
10383 IF (k(i,4).EQ.0) ubuft(j,ntrv(j),7)=0.
10384 IF (ievt.GE.lome(1).AND.ievt.LE.lome(2))
THEN
10385 WRITE(*,*)
'TRACK ',i,
'FROM VTX ',j,
' PARENTID=',lbea(j)
10395 temulx=
rndmm(iseed)*140.-70.
10396 temuly=
rndmm(iseed)*140.-70.
10397 ftuple(iof2+1)=temulx
10398 ftuple(iof2+2)=temuly
10410 CALL mzbook(ixevt,jgege,jgeev,-3,
'GEGE',nvtx,nvtx,7,3,0)
10411 CALL mzbook(ixevt,jgebe,jgeev,-4,
'GEBE',0,0,14,3,0)
10421 WRITE(lout)idevt,lnu,llep,lcha,nvtx+1,ntrk,enu
10422 IF (ievt.GE.lome(1).AND.ievt.LE.lome(2))
THEN
10423 WRITE(*,*)
'OUTPUT-EVT',idevt,lnu,llep,lcha,nvtx+1,ntrk,enu
10428 q(jgebe+iju)=
vect(iju)
10429 q(jgebe+iju+3)=gkin(iju)
10444 q(jgebe+6+iri)=beamft(iri)
10447 WRITE(lout)1,1,0,0,(
vect(kk),kk=1,3)
10448 WRITE(lout)1,1,1,neutype,(gkin(kk),kk=1,3), (beamft(kk),kk=1,7)
10449 IF (ievt.GE.lome(1).AND.ievt.LE.lome(2))
THEN
10450 WRITE(*,*)
'OUTPUT-VERT-NEUTRINO ',1,1,0,0,(
vect(kk),kk=1,3)
10451 WRITE(*,*)
'OUTPUT-PART-NEUTRINO ' ,1,1,1,neutype,(gkin(kk),kk=
10452 + 1,3), (beamft(kk),kk=1,7)
10456 itruentbeam=daluaef(ntbeam(j))
10457 IF (ntrv(j).EQ.0)
THEN
10458 WRITE(*,*)
'DANGER! VERTEX WITH 0 TRACKS:NVTX=',nvtx
10459 WRITE(*,*)
'VERT,IDEVT=',vert(j,3),idevt
10461 WRITE(*,*)
'END DANGER! '
10464 tmpar(jj)=vert(j,jj)/10.
10467 CALL mzbook(ixevt,jgevt,jgege,-j,
'GEVT',ntrv(j),ntrv(j),7,3,0)
10470 q(jgevt+3)=itruentbeam
10473 q(jgevt+4+jj)=tmpar(jj)
10475 WRITE(lout)j+1,ntrv(j),itruentbeam,lbea(j),
10476 + (tmpar(jj),jj=1,3)
10477 IF (ievt.GE.lome(1).AND.ievt.LE.lome(2))
THEN
10478 WRITE(*,*)
'OUTPUT-VERT=',j,ntrv(j),itruentbeam,lbea(j),
10479 + (tmpar(jj),jj=1,3)
10486 CALL mzbook(ixevt,jgetr,jgevt,-i,
'GETR',0,0,14,3,0)
10487 q(jgetr+1)=ktrk(j,i)
10490 q(jgetr+4)=
ipart(j,i)
10492 q(jgetr+4+kk)=plab(j,i,kk)
10495 q(jgetr+7+kk)=ubuft(j,i,kk)
10497 WRITE(lout)ktrk(j,i)+1,i,j+1,
ipart(j,i),(plab(j,i,kk),kk=1,3),
10498 + (ubuft(j,i,kk),kk=1,7)
10499 IF (ievt.GE.lome(1).AND.ievt.LE.lome(2))
THEN
10500 WRITE(*,*)
'OUTPUT-TRACK=',ktrk(j,i),i,j,
ipart(j,i), (plab(j
10501 + ,i,kk),kk=1,3), (ubuft(j,i,kk),kk=1,7)
10503 IF (
ipart(j,i).EQ.34.OR.
10504 +
ipart(j,i).EQ.33)
THEN
10505 ftuple(80)=ubuft(j,i,7)
10508 IF (
ipart(j,i).EQ.35.OR.
ipart(j,i).EQ.36.OR.
10515 ftuple(iof1+10)=ubuft(j,i,7)
10516 ftuple(iof1+11)=
ipart(j,i)
10517 ftuple(iof1+12)=ubuft(j,i,2)
10518 ftuple(iof1+13)=ubuft(j,i,3)
10519 ftuple(iof1+15)=plab(j,i,1)
10520 ftuple(iof1+16)=plab(j,i,2)
10521 ftuple(iof1+17)=plab(j,i,3)
10524 IF(ubuft(j,i,7).EQ.0)
THEN
10526 pla=
sqrt(plab(j,i,1)**2+plab(j,i,2)**2+plab(j,i,3)**2)
10535 IF (lstrfrom(j,i).GT.0)
THEN
10536 ptsr=plab(j,i,1)*vstr(1)+ plab(j,i,2)*vstr(2)+plab(j,i,3)
10538 ptstrfin=
sqrt(pla**2-ptsr**2)
10539 thcas=
rndmm(iseed)*3.141*2
10540 CALL hfill(1011,ptstrfin*
cos(thcas),0.,1.)
10541 CALL hfill(1011,ptstrfin*
sin(thcas),0.,1.)
10543 IF (lstrda(j,i).GT.0)
THEN
10544 ptsr=plab(j,i,1)*vstr(1)+ plab(j,i,2)*vstr(2)+plab(j,i,3)
10546 ptstrfin=
sqrt(pla**2-ptsr**2)
10547 thcas=
rndmm(iseed)*3.141*2
10554 IF (
ipart(j,i).EQ.8)
THEN
10556 CALL hfill(1015,xf,0.,1.)
10559 IF (
ipart(j,i).EQ.9)
THEN
10561 CALL hfill(1016,xf,0.,1.)
10564 IF (w2.GT.5.AND.q2.GT.1)
THEN
10565 IF (ichg.GT.0)
THEN
10566 CALL hfill(1013,zzz,0.,1.)
10568 CALL hfill(1014,zzz,0.,1.)
10571 CALL hfill(1012,ptstrfin*
cos(thcas),0.,1.)
10572 CALL hfill(1012,ptstrfin*
sin(thcas),0.,1.)
10586 SUBROUTINE lazimu(XP,ZP)
10589 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
10590 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
10593 sgn=sign(1.,2.5-lst(24))
10597 IF(lst(30).EQ.1) ih=2
10599 IF(lst(23).EQ.2)
THEN
10600 a=pari(24)*
dqcd(0,j,1,xp,zp,
y)+pari(25)*
dqcd(0,j,2,xp,zp,
y)
10601 & -lst(30)*isign(1,ifl)*pari(26)*
dqcd(0,j,3,xp,zp,
y)
10602 b=
dqcd(1,j,1,xp,zp,
y)
10603 & +sgn*lst(30)*isign(1,ifl)*
dqcd(1,j,3,xp,zp,
y)
10604 c=
dqcd(2,j,1,xp,zp,
y)
10606 a=(ewqc(1,ih,i)+ewqc(2,ih,i))*(pari(24)*
dqcd(0,j,1,xp,zp,
y)+
10607 & pari(25)*
dqcd(0,j,2,xp,zp,
y))
10608 & -lst(30)*isign(1,ifl)*(ewqc(1,ih,i)-ewqc(2,ih,i))
10609 & *pari(26)*
dqcd(0,j,3,xp,zp,
y)
10610 b=(ewqc(1,ih,i)+ewqc(2,ih,i))*
dqcd(1,j,1,xp,zp,
y)
10611 & +sgn*lst(30)*isign(1,ifl)*(ewqc(1,ih,i)-ewqc(2,ih,i))
10612 & *
dqcd(1,j,3,xp,zp,
y)
10613 c=(ewqc(1,ih,i)+ewqc(2,ih,i))*
dqcd(2,j,1,xp,zp,
y)
10615 phimax=abs(
a)+abs(b)+abs(c)
10630 COMMON /contro/ binit,lunb,npneut,npanti,cpnorm,xpsour,sigdiv
10631 COMMON /fluxes/ fluxd(80000),
weight(8),specd(800),specn(800)
10632 COMMON /input/ iall(80000),ncount(8)
10639 COMMON /polariz/pol(4000,3)
10642 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
10645 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
10649 parameter(icento=100)
10653 parameter(lux_level=4)
10654 INTEGER*4 jtau(100),jpri(100),jstro(100)
10655 REAL*4 ftuple(isiz)
10656 common/jettagl/jtau,jpri,jstro
10657 common/ntupla/ftuple,isfirst
10658 common/beam/spec(icento)
10659 COMMON /maxspec/rmaxspec,rintspec
10660 common/sav/xminsav(icento),xmaxsav(icento),yminsav(icento),
10661 & ymaxsav(icento),q2minsav(icento),q2maxsav(icento),
10662 & w2minsav(icento),w2maxsav(icento),parimax(icento),
10663 & ppsave(icento,3,4,5),paricor(icento),
index,sigmasav(icento),
10669 common/foreficass/ievt
10674 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
10692 IF (k(i,2).EQ.92)
THEN
10698 IF(jtau(i).EQ.1)
THEN
10699 IF(
luchge(k(i,2)).NE.0)
THEN
10701 enetauchg=enetauchg+
p(i,4)
10704 enetauneu=enetauneu+
p(i,4)
10708 IF(jpri(i).EQ.1)
THEN
10709 IF(
luchge(k(i,2)).NE.0)
THEN
10711 eneprichg=eneprichg+
p(i,4)
10714 eneprineu=eneprineu+
p(i,4)
10726 ftuple(24)=enetauchg
10727 ftuple(25)=enetauneu
10728 ftuple(26)=eneprichg
10729 ftuple(27)=eneprineu
10743 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
10744 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
10745 COMMON /lflmix/ cabibo(4,4)
10746 COMMON /loptim/ optx(4),opty(4),optq2(4),optw2(4),comfac
10747 COMMON /lgrid/ nxx,nww,
xx(20),ww(15),pqg(20,15,3),pqqb(20,15,2),
10748 &qgmax(20,15,3),qqbmax(20,15,2),ycut(20,15),xtot(20,15),np
10749 COMMON /flgrid/ nfx,nfq,xr(2),qr(2),flqt(41,16),flgt(41,16),
10751 COMMON /pypara/ ipy(80),pypar(80),pyvar(80)
10752 COMMON /lminui/ xkin(4),ukin(4),wkin(4),ain(4),
bin(4),
10753 &maxfin,relup,relerr,reler2,fcnmax
10754 COMMON /lminuc/ namkin(4),nam(30)
10755 CHARACTER*10 namkin,nam
10758 DATA cut/1.
e-04,1.,0.,1.,4.,1.
e+08,5.,1.
e+08,.1,1.
e+08,.1,1.
e+08,
10760 DATA lst/0,1,5,1,3,1,1,12,5,1,0,4,5,1,1,1,0,2,3,21*0/
10761 DATA parl/1.,1.,0.44,0.75,0.226,0.,0.,0.015,2.,0.,0.01,4.,
10762 &0.001,0.44,0.01,7.29735
e-03,1.16637
e-05,0.044,0.03,1.,10*0./
10765 DATA qc/-.33333,.66667,-.33333,.66667,-.33333,.66667,
10767 DATA cabibo/.95,.05,2*0.,.05,.948,.002,2*0.,.002,.998,4*0.,1./
10768 DATA optx/1.,3*0./,opty/1.,3*0./,optq2/1.,3*0./,optw2/1.,3*0./
10769 DATA nxx,nww/20,15/
10770 DATA pqg,pqqb,qgmax,qqbmax/3000*0./,ycut/300*0./,xtot/300*0./
10771 DATA nfx,nfq/41,16/,flqt,flgt,flmt/1968*0./
10772 DATA xkin/1.,2.,3.,4./,ukin,wkin,ain,
bin/16*0./,maxfin/2000/
10773 DATA relup,relerr,reler2/0.1,0.05,0.05/
10774 DATA namkin/
' X',
' ',
' ',
' '/
10776 1 0, 0, 2, 2, 6, 1, 1, 6, 3, 1,
10777 2 3, 1, 1, 2, 1, 1, 4, 1, 1, 1,
10778 3 0, 1, 1, 1, 1, 1, 1, 0, 0, 0,
10779 4 1, 2, 1, 1, 30, 33, 1, 1, 7, 0,
10780 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
10781 6 0, 0, 0, 1, 100, 0, 0, 0, 0, 0,
10782 7 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
10783 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
10784 DATA (pypar(i),i=1,40)/
10785 1 7.299
e-03, 2.290
e-01, 2.000
e-01, 2.500
e-01, 4.000
e+00,
10786 1 1.000
e+00, 4.400
e-01, 4.400
e-01, 7.500
e-02, 0.000
e+00,
10787 2 2.000
e+00, 2.000
e+00, 1.000
e+00, 0.000
e+00, 3.000
e+00,
10788 2 1.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 1.000
e+00,
10789 3 2.500
e-01, 1.000
e+00, 2.000
e+00, 1.000
e-03, 1.000
e+00,
10790 3 1.000
e+00, 1.000
e+00, -2.000
e-02, -1.000
e-02, 0.000
e+00,
10791 4 0.000
e+00, 1.600
e+00, 0.500
e+00, 0.200
e+00, 3.894
e-01,
10792 4 1.000
e+00, 3.300
e-01, 6.600
e-01, 0.000
e+00, 1.000
e+00/
10793 DATA (pypar(i),i=41,80)/
10794 5 2.260
e+00, 1.000
e+04, 1.000
e-04, 0.000
e+00, 0.000
e+00,
10795 5 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
10796 6 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
10797 6 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
10798 7 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
10799 7 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
10800 8 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
10801 8 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00/
10821 parameter(icento=100)
10825 parameter(lux_level=4)
10826 INTEGER*4 jtau(100),jpri(100),jstro(100)
10827 REAL*4 ftuple(isiz)
10828 common/jettagl/jtau,jpri,jstro
10829 common/ntupla/ftuple,isfirst
10830 common/beam/spec(icento)
10831 COMMON /maxspec/rmaxspec,rintspec
10832 common/sav/xminsav(icento),xmaxsav(icento),yminsav(icento),
10833 & ymaxsav(icento),q2minsav(icento),q2maxsav(icento),
10834 & w2minsav(icento),w2maxsav(icento),parimax(icento),
10835 & ppsave(icento,3,4,5),paricor(icento),
index,sigmasav(icento),
10840 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
10841 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
10842 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
10843 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
10844 COMMON /loptim/ optx(4),opty(4),optq2(4),optw2(4),comfac
10845 COMMON /flinfo/ rflq,rflg,rflm,rflt
10846 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
10847 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
10848 common/wlist/ww1,ww2,ww3,ww5
10849 dimension pqh(17,2),pnt(2,2),xpq(-6:6)
10850 DOUBLE PRECISION dari27,dari28
10851 DATA dari27,dari28/2*0.d0/
10852 DATA w2low,w2upp,ylow,yupp,q2low,q2upp/6*0./
10879 s=parl(21)+psave(3,1,5)**2+psave(3,2,5)**2
10880 pm2=psave(3,2,5)**2
10881 IF(lst(2).NE.1)
THEN
10886 IF (parl(21).GT.0)
THEN
10887 aaa= 0.5*(1.-rml**2/(parl(21)*
x)-2.* (rml*rmm/parl(21))**2)
10888 + /(1.+
x*rmm**2/parl(21))
10889 bbb=0.5*
sqrt((1.-rml**2/(parl(21)*
x))**2-(2.*rml*rmm/parl(21)
10890 + )**2) /(1.+
x*rmm**2/parl(21))
10892 WRITE(*,*)
'WARNING: 2PK==0'
10897 txlow=rml**2/2./rmm/(ee+rmm)
10899 q2low=max(q2min,
x*ymin*
s,(w2min-pm2)*
x/max(1.-
x,1.
e-22))
10900 q2upp=min(q2max,
x*ymax*
s,(w2max-pm2)*
x/max(1.-
x,1.
e-22))
10901 ylowcmp=max(ymin,q2min/max(
s*
x,1.
e-22), (w2min-pm2)/max(
s*(1.-
10903 yuppcmp=min(ymax,q2max/max(
s*
x,1.
e-22), (w2max-pm2)/max(
s*(1.-
10905 ylow=max(ymin,q2min/max(
s*
x,1.
e-22), (w2min-pm2)/max(
s*(1.-
x),
10907 yupp=min(ymax,q2max/max(
s*
x,1.
e-22), (w2max-pm2)/max(
s*(1.-
x),
10912 w2low=max(w2min,(1.-
x)*ymin*
s+pm2,q2min*(1.-
x)/max(
x,1.
e-22)+
10914 w2upp=min(w2max,(1.-
x)*ymax*
s+pm2,q2max*(1.-
x)/max(
x,1.
e-22)+
10919 IF(pari(28).LT.0.5)
THEN
10924 50 dari28=dari28+1.d0
10934 which=(optx(1)+optx(2)+optx(3)+optx(4))*
rlu(0)
10935 IF(which.LE.optx(1))
THEN
10937 ELSEIF(which.LE.(optx(1)+optx(2)))
THEN
10939 ELSEIF(which.LE.(optx(1)+optx(2)+optx(3)))
THEN
10944 IF(lst(31).EQ.1)
THEN
10950 q2low=max(q2min,
x*ymin*
s,(w2min-pm2)*
x/(1.-
x))
10951 q2upp=min(q2max,
x*ymax*
s,(w2max-pm2)*
x/(1.-
x))
10952 IF(q2upp.LT.q2low) goto 60
10953 which=(optq2(1)+optq2(2)+optq2(3)+optq2(4))*
rlu(0)
10954 IF(which.LE.optq2(1))
THEN
10955 q2=q2low+
rlu(0)*(q2upp-q2low)
10956 ELSEIF(which.LE.(optq2(1)+optq2(2)))
THEN
10957 q2=q2low*(q2upp/q2low)**
rlu(0)
10958 ELSEIF(which.LE.(optq2(1)+optq2(2)+optq2(3)))
THEN
10959 q2=q2low*q2upp/(q2upp+
rlu(0)*(q2low-q2upp))
10961 q2=
sqrt((q2low*q2upp)**2/(q2upp**2+
rlu(0)*(q2low**2-q2upp**2)
10965 IF(
y.LT.ymin.OR.
y.GT.ymax) goto 50
10966 ELSEIF(lst(31).EQ.2)
THEN
10972 ylow=max(ymin,q2min/(
s*
x),(w2min-pm2)/(
s*(1.-
x)))
10973 yupp=min(ymax,q2max/(
s*
x),(w2max-pm2)/(
s*(1.-
x)))
10974 IF(yupp.LT.ylow) goto 60
10975 which=(opty(1)+opty(2)+opty(3)+opty(4))*
rlu(0)
10976 IF(which.LE.opty(1))
THEN
10977 y=ylow+
rlu(0)*(yupp-ylow)
10978 ELSEIF(which.LE.(opty(1)+opty(2)))
THEN
10979 y=ylow*(yupp/ylow)**
rlu(0)
10980 ELSEIF(which.LE.(opty(1)+opty(2)+opty(3)))
THEN
10981 y=ylow*yupp/(yupp+
rlu(0)*(yupp-ylow))
10983 y=
sqrt((ylow*yupp)**2/(yupp**2+
rlu(0)*(ylow**2-yupp**2)))
10986 IF(q2.LT.q2min.OR.q2.GT.q2max) goto 50
10987 ELSEIF(lst(31).EQ.3)
THEN
10993 w2low=max(w2min,(1.-
x)*ymin*
s+pm2,q2min*(1.-
x)/
x+pm2)
10994 w2upp=min(w2max,(1.-
x)*ymax*
s+pm2,q2max*(1.-
x)/
x+pm2)
10995 IF(w2upp.LT.w2low) goto 60
10996 which=(optw2(1)+optw2(2)+optw2(3)+optw2(4))*
rlu(0)
10997 IF(which.LE.optw2(1))
THEN
10998 w2=w2low+
rlu(0)*(w2upp-w2low)
10999 ELSEIF(which.LE.(optw2(1)+optw2(2)))
THEN
11000 w2=w2low*(w2upp/w2low)**
rlu(0)
11001 ELSEIF(which.LE.(optw2(1)+optw2(2)+optw2(3)))
THEN
11002 w2=w2low*w2upp/(w2upp+
rlu(0)*(w2low-w2upp))
11004 w2=
sqrt((w2low*w2upp)**2/(w2upp**2+
rlu(0)*(w2low**2-w2upp**2)
11007 y=(w2-
p(2,5)**2)/((1.-
x)*parl(21))
11009 IF(
y.LT.ymin.OR.
y.GT.ymax) goto 50
11010 IF(q2.LT.q2min.OR.q2.GT.q2max) goto 50
11016 70
IF(
lkinem(lst(2)).NE.0)
THEN
11018 IF(lst(2).EQ.1)
THEN
11019 IF(ncut.LE.9999) goto 50
11020 IF(lst(3).GE.1)
then
11034 pari(24)=(1.+(1.-
y)**2)/2.
11036 pari(26)=(1.-(1.-
y)**2)/2.
11040 IF(parl(6).GT.+0.99) ih=2
11041 80 lst(30)=sign(1.,ih-1.5)
11045 IF(lst(23).EQ.2)
THEN
11047 IF(ksave(1).LT.0.AND.ih.EQ.1
11048 + .OR.ksave(1).GT.0.AND.ih.EQ.2) goto 110
11050 yq=pari(24)-lst(30)*pari(26)
11051 yqb=pari(24)+lst(30)*pari(26)
11052 IF(pari(11).GT.1.
e-06)
THEN
11053 IF(k(3,2).LT.0)
THEN
11054 pnt(1,ih)=(1.-pari(11))*pari(13)*yq
11055 pnt(2,ih)=pari(11)*pari(12)*yq
11057 pnt(1,ih)=(1.-pari(11))*pari(12)*yq
11058 pnt(2,ih)=pari(11)*pari(13)*yq
11062 IF(k(3,2)*qc(i).LT.0)
THEN
11063 pqh(i,ih)=xpq(i)*yq
11065 pqh(i+lst(12),ih)=xpq(-i)*yqb
11070 gfq2=q2/(pmas(23,1)**2+q2)*
sqrt(2.)*parl(17)*pmas(23,1)**2/
11071 + (3.1415927*parl(16))
11074 IF(lst(18).GE.2) aemcor=
ulalem(q2)/parl(16)
11076 zlep=zl(ih,ilep+2*inu)
11077 DO 100 i=1,max(lst(12),lst(13))
11078 a=(-ig*qc(i)*aemcor+
iz*gfq2*zlep*zq(ih,i))**2
11079 b=(-ig*qc(i)*aemcor+
iz*gfq2*zlep*zq(ii,i))**2
11083 IF(i.GT.lst(12)) goto 100
11084 fyq=(
a+b)*pari(24)+(
a-b)*pari(26)
11085 pqh(i,ih)=xpq(i)*fyq
11086 IF(i.LE.2.AND.pari(11).GT.1.
e-06)
THEN
11087 pnt(1,ih)=pnt(1,ih)+(1.-pari(11))*pari(11+i)*fyq
11088 pnt(2,ih)=pnt(2,ih)+pari(11)*pari(14-i)*fyq
11090 pqh(i+lst(12),ih)=xpq(-i)*((
a+b)*pari(24)-(
a-b)*pari(26))
11095 120 pqh(17,ih)=pqh(17,ih)+pqh(i,ih)+pqh(i+lst(12),ih)
11097 IF(abs(parl(6)).LT.0.99.AND.ih.EQ.1)
THEN
11102 IF (lst(32).NE.0.AND.lst(23).EQ.2)
THEN
11109 f2cc=xpq(1)+xpq(-2)+xpq(3)+xpq(-4)
11110 f3cc=(xpq(1)-xpq(-2)+xpq(3)-xpq(-4))/
x
11118 WRITE(*,*)
'WARNING:X==0'
11131 a1=(
x*
y + rml**2 /parl(21) ) *
y
11132 a2=(1.-
y)- ( rmm**2*
x*
y/parl(21) + (rml*rmm/parl(21))**2 )
11133 a3=(
x*
y*(1.-
y/2.) - rml**2/(2.*parl(21))*
y )
11134 a5=-rml**2/parl(21)
11140 c1=(
x*
y + rml**2 /parl(21) ) *
y
11141 c2=(1.-
y)- ( rmm**2*
x*
y/parl(21) + (rml*rmm/parl(21))**2 )
11142 c3=(
x*
y*(1.-
y/2.) - rml**2/(2.*parl(21))*
y )
11143 c5=-rml**2/parl(21)
11151 pp=a1*
f1+a2*f2cc+a3*f3cc+a5*f5
11152 pppp=
c1*
f1+c2*f2cc+c3*f3cc+c5*f5
11153 ppp=a1*
f1+a2*f2cc+a3*f3cc
11154 p17=(1.-parl(6))/2.*pqh(17,1)+(1.+parl(6))/2.*pqh(17,2)
11157 p17ok=(1.-parl(6))/2.*pppp+(1.+parl(6))/2.*pqh(17,2)
11158 IF( abs(p17ok-p17).GT.0.00005)
THEN
11159 WRITE(*,*)
'TAU LEPTON X-SECTION WRONG',p17ok,p17
11165 IF(
x.LT.txlow) pp=0.
11171 ww1=f2cc*(1./u+0.5/
x/rmm)
11173 ww3=-f2cc/u/
x*
sqrt(1+ (q2/u)**2 )
11192 IF(lst(23).EQ.1.AND.lst(11).NE.0.AND.lst(2).NE.-3)
THEN
11194 lqcd=
mod(lst(11),10)
11195 ltm=
mod(lst(11)/10,10)
11199 IF(lqcd.EQ.1.OR.ltm.EQ.1) CALL
flipol(flq,flg,flm)
11201 IF(lst(2).GT.0.AND.
11202 + (lqcd.EQ.2.OR.ltm.EQ.2)) CALL
flintg(flq,flg,flm)
11203 IF(ltm.GE.1.OR.lht.GE.1)
THEN
11206 130 f2em=f2em+qc(i)**2*(xpq(i)+xpq(-i))
11207 IF(ltm.GE.1) flm=flm-2.*
x**2*psave(3,2,5)**2/q2*f2em
11208 IF(lht.GE.1) flt=8.*parl(19)/q2*f2em
11213 pqh(17,ih)=pqh(17,ih)-
y**2*(flq+flg+flm+flt)
11215 140 pqh(i,ih)=pqh(i,ih)*pqh(17,ih)/pqh17
11219 150 pq(i)=(1.-parl(6))/2.*pqh(i,1)+(1.+parl(6))/2.*pqh(i,2)
11222 rflq=-
y**2*flq/pq(17)
11223 rflg=-
y**2*flg/pq(17)
11224 rflm=-
y**2*flm/pq(17)
11225 rflt=-
y**2*flt/pq(17)
11228 IF(lst(31).EQ.1)
THEN
11229 IF(lst(23).EQ.2)
THEN
11230 comfac=1./
x/(1.+q2/pmas(24,1)**2)**2
11234 ELSEIF(lst(31).EQ.2)
THEN
11235 IF(lst(23).EQ.2)
THEN
11236 comfac=1./(1.+q2/pmas(24,1)**2)**2*parl(21)
11238 comfac=1./q2**2*parl(21)
11240 ELSEIF(lst(31).EQ.3)
THEN
11241 IF(lst(23).EQ.2)
THEN
11242 comfac=1./
x/(1.+q2/pmas(24,1)**2)**2 *
x/(1.-
x)
11244 comfac=1./
x/q2**2 *
x/(1.-
x)
11254 IF(lst(2).LE.-2)
RETURN
11259 xfact=optx(1)+optx(2)+optx(3)+optx(4)
11260 IF(lst(31).EQ.1)
THEN
11261 hq2=optq2(1)/(q2upp-q2low)
11262 + +1./alog(q2upp/q2low)*optq2(2)/q2
11263 + +q2low*q2upp/(q2upp-q2low)*optq2(3)/q2**2
11264 + +2*(q2low*q2upp)**2/(q2upp**2-q2low**2)*optq2(4)/q2**3
11265 q2fact=optq2(1)+optq2(2)+optq2(3)+optq2(4)
11266 comfac=comfac*xfact*q2fact/hx/hq2
11267 ELSEIF(lst(31).EQ.2)
THEN
11268 hy=opty(1)/(yupp-ylow)+1./alog(yupp/ylow)*opty(2)/
y
11269 + +ylow*yupp/(yupp-ylow)*opty(3)/
y**2
11270 + +2*(ylow*yupp)**2/(yupp**2-ylow**2)*opty(4)/
y**3
11271 yfact=opty(1)+opty(2)+opty(3)+opty(4)
11272 comfac=comfac*xfact*yfact/hx/hy
11273 ELSEIF(lst(31).EQ.3)
THEN
11274 hw2=optw2(1)/(w2upp-w2low)
11275 + +1./alog(w2upp/w2low)*optw2(2)/w2
11276 + +w2low*w2upp/(w2upp-w2low)*optw2(3)/w2**2
11277 + +2*(w2low*w2upp)**2/(w2upp**2-w2low**2)*optw2(4)/w2**3
11278 w2fact=optw2(1)+optw2(2)+optw2(3)+optw2(4)
11279 comfac=comfac*xfact*w2fact/hx/hw2
11281 IF(lst(2).LE.0)
RETURN
11284 sigl=(1.-parl(6))/2.*pqh(17,1)
11285 sigr=(1.+parl(6))/2.*pqh(17,2)
11287 IF(lst(2).EQ.1)
THEN
11290 dari27=dari27+dble(sigma)*dble(comfac)*
weight
11292 viol=sigma*comfac/pari(lst(23))
11293 IF(viol.GT.pari(32))
THEN
11295 IF(pari(32).GT.1.)
THEN
11296 pari(lst(23))=pari(lst(23))*pari(32)
11297 IF(lst(3).GE.1)
WRITE(6,10100) pari(32),
int(pari(30)+1),
11298 + pari(lst(23)),
x,
y,q2,w2
11302 IF(viol.LT.
rlu(0)) goto 50
11303 parl(24)=pari(31)*dari27/dari28
11306 IF(abs(parl(6)).LT.0.99)
THEN
11309 IF(
rlu(0)*sigma.GT.sigl) ih=2
11311 lst(30)=sign(1.,ih-1.5)
11316 IF(pari(11).GT.1.
e-06)
THEN
11317 IF(
rlu(0).LT.(pari(11)*(pqh(17,ih)-pnt(1,ih)-pnt(2,ih))+
11318 + pnt(2,ih))/pqh(17,ih))
THEN
11323 rcross=pari(31)*pq(17)*comfac
11331 10000
FORMAT(
' WARNING: LEPTOX IS LOOPING, CANNOT FIND ALLOWED ',
11332 +
'PHASE SPACE POINT DUE TO CUTS,',/,
11333 +10
x,
'CHECK, IN PARTICULAR, CUT(11) TO CUT(14)')
11334 10100
FORMAT(
' WARNING: MAXIMUM VIOLATED BY A FACTOR ',f7.3,
11335 +
' IN EVENT ',i7,/,
' MAXIMUM INCREASED BY THIS FACTOR TO ',e12.3,
11336 +/,
' POINT OF VIOLATION: X, Y, Q**2, W**2 = ',4g10.3)
11353 SUBROUTINE lflav(IFL,IFLR)
11355 common/cfread/space(5000)
11356 common/mykeys/ievar,if5cc,ineut,iinte,iferm,iflat,icoun,
11357 & refix,imudo,ikat1,ikat2,ikat3,ikat4,ikat5,ikat6,
11358 & inevt,ijak1,ijak2,iitdk,rptau,rxk0d,ntgr,idimuon,iglu,
11359 & iqden,lome(2),ifiles,iccha,iseed,idsubs,ionem,ehac,ipsel,
11365 parameter(charmsens=10000)
11366 common/myerr/icrack
11373 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
11374 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
11375 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
11376 COMMON /lflmix/ cabibo(4,4)
11379 IF(lst(24).EQ.3)
THEN
11392 IF(
r.LE.psub) goto 30
11395 IF(ifl.GT.nfl) ifl=nfl-ifl
11399 IF(lst(23).EQ.2)
THEN
11410 psub=psub+cabibo(m1*j2+m2*j1,m2*j2+m1*j1)
11411 IF(
r.LT.psub) goto 50
11414 IF(lst(25).LT.0) ifl=-ifl
11421 IF (idimuon.GE.1.AND.imaxdimu.EQ.0)
THEN
11422 WRITE(*,*)
'SKIPPING CHARM PRODUCTION: CRACK ALARM'
11427 IF (idimuon.GE.1.AND.ifla.NE.4)
THEN
11428 rsmall=
rndmm(iseed)
11429 IF (rsmall.GT.0.05) goto 10
11431 IF(ifla.GE.4.OR.iflra.GE.4)
THEN
11433 IF(1.-(.938+pmas(
lucomp(ifla),1)+pmas(
lucomp(iflra),1)
11434 + +2.*pmas(1,1))**2/w2.LT.
rlu(0))
THEN
11435 imaxdimu=imaxdimu-1
11436 goto(10,60 ,60 ) lst(24)
11442 IF(lst(24).EQ.3)
RETURN
11443 IF(lst(8).GT.10.AND.lst(8).NE.19)
RETURN
11447 IF(lst(14).EQ.0)
RETURN
11448 IF(iflr.EQ.-2)
THEN
11449 IF(lst(22).EQ.1)
THEN
11451 IF(
rlu(0).GT.parl(4)) iflr=2103
11455 ELSEIF(iflr.EQ.-1)
THEN
11456 IF(lst(22).EQ.1)
THEN
11460 IF(
rlu(0).GT.parl(4)) iflr=2103
11475 SUBROUTINE lframe(IFR,IPH)
11479 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
11480 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
11481 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
11482 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
11483 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
11484 COMMON /lboost/
dbeta(2,3),stheta(2),sphi(2),pb(5),phir
11487 COMMON /polariz/pol(4000,3)
11490 DOUBLE PRECISION dtheta,dphi,
dbeta,dbetadbg(3)
11491 INTEGER ifr,iph,iframe,iphi
11497 IF(iframe.LT.1.OR.iframe.GT.4.OR.iphi.LT.0.OR.iphi.GT.1)
11499 IF(iframe.EQ.1) iphi=0
11505 IF(iphi.NE.lst(29))
THEN
11510 IF((iframe.EQ.lst(28)).AND.(iphi.EQ.lst(29)))
THEN
11519 goto(40 ,50 ,70 ,90 ), lst(28)
11522 40
IF(iframe.GE.2)
THEN
11523 CALL ludbrb(0,0,stheta(2),sphi(2),0.d0,0.d0,0.d0)
11532 50
IF(lst(6).NE.0.AND.iphi.NE.lst(29))
THEN
11533 CALL ludbrb(0,0,0.,sign(phir,float(iphi-lst(29))),0.d0,0.d0,
11538 IF(iframe.EQ.1)
THEN
11540 CALL ludbrb(0,0,-stheta(2),0.,0.d0,0.d0,0.d0)
11542 ELSEIF(iframe.GE.3)
THEN
11543 IF(lst(17).EQ.0)
THEN
11544 CALL ludbrb(0,0,0.,0.,0.d0,0.d0,
dbeta(1,3))
11545 IF(psave(3,1,3).LT.0.)
THEN
11550 IF(
dbeta(1,3).EQ.0)
THEN
11552 dbetadbg(j)= (dble(psave(3,1,j))+dble(psave(3,2,j)))/
11553 + (dble(psave(3,1,4))+dble(psave(3,2,4)))
11555 CALL ludbrb(0,0,stheta(1),sphi(1),0.d0,0.d0,0.d0)
11556 CALL ludbrb(0,0,0.,0.,dbetadbg(1),dbetadbg(2),dbetadbg(3))
11558 CALL ludbrb(0,0,stheta(1),sphi(1),0.d0,0.d0,0.d0)
11566 70
IF(iframe.LE.2)
THEN
11567 IF(lst(17).EQ.0)
THEN
11568 IF(psave(3,1,3).LT.0.)
THEN
11572 CALL ludbrb(0,0,0.,0.,0.d0,0.d0,-
dbeta(1,3))
11575 CALL ludbrb(0,0,0.,-sphi(1),0.d0,0.d0,0.d0)
11576 CALL ludbrb(0,0,-stheta(1),0.,0.d0,0.d0,0.d0)
11579 ELSEIF(iframe.EQ.4)
THEN
11582 CALL ludbrb(0,0,0.,-phibos,0.d0,0.d0,0.d0)
11583 CALL ludbrb(0,0,-thebos,0.,0.d0,0.d0,0.d0)
11588 90
IF(iframe.LE.3)
THEN
11589 CALL ludbrb(0,0,thebos,phibos,0.d0,0.d0,0.d0)
11594 100
WRITE(*,10000) iframe,iphi,lst(28),lst(29)
11595 10000
FORMAT(
' BAD VARIABLES IN SUBROUTINE LFRAME: IFRAME,IPHI,',
11596 +
'LST(28),LST(29) =',4i5)
11610 SUBROUTINE linit(LFILE,LEPIN,PLZ,PPZ,INTER)
11618 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
11619 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
11620 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
11621 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
11622 COMMON /lgrid/ nxx,nww,
xx(20),ww(15),pqg(20,15,3),pqqb(20,15,2),
11623 +qgmax(20,15,3),qqbmax(20,15,2),ycut(20,15),xtot(20,15),np
11624 COMMON /loptim/ optx(4),opty(4),optq2(4),optw2(4),comfac
11625 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
11626 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
11627 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
11628 COMMON /lboost/
dbeta(2,3),stheta(2),sphi(2),pb(5),phir
11629 COMMON /lminui/ xkin(4),ukin(4),wkin(4),ain(4),
bin(4),
11630 +maxfin,relup,relerr,reler2,fcnmax
11631 COMMON /lminuc/ namkin(4),nam(30)
11632 COMMON /lpflag/ lst3
11633 COMMON /pypara/ ipy(80),pypar(80),pyvar(80)
11634 CHARACTER*10 namkin,nam
11635 dimension lstw(40),parlw(30)
11636 DOUBLE PRECISION dtheta,dphi,
dbeta
11637 DATA pi/3.1415927/,ncall/0/
11659 IF (ncall.EQ.1)
THEN
11660 CALL
lugive(
'PMAS(15,1)=1.777')
11661 WRITE(*,*)
' ACTUAL CTAU LIFETIME IN MM:',pmas(15,4)
11662 CALL
lugive(
'PMAS(15,4)=0.0886')
11680 IF(lst(32).NE.0)
THEN
11681 IF (lepin.NE.16)
THEN
11682 WRITE(*,*)
'***WARNING: LST(32) OPTION TESTED ONLY WITH TAU'
11687 IF(lst(8).LT.2)
THEN
11698 IF(
mod(lst(8),10).EQ.3.OR.
mod(lst(8),10).EQ.5) ipy(13)=0
11699 IF(
mod(lst(8),10).EQ.4.OR.
mod(lst(8),10).EQ.5) ipy(14)=0
11703 IF(lst(18).GE.1)
THEN
11705 pmas(24,1)=
sqrt(pi*parl(16)/(
sqrt(2.)*parl(17)*parl(5)*
11707 pmas(23,1)=pmas(24,1)/
sqrt(1.-parl(5))
11710 zl(1,1)=-.5+parl(5)
11719 zq(1,ifl)=sign(0.5,qc(ifl))-qc(ifl)*parl(5)
11720 10 zq(2,ifl)=-qc(ifl)*parl(5)
11740 p(1,4)=
sqrt(
p(1,3)**2+
p(1,5)**2)
11745 p(2,4)=
sqrt(
p(2,3)**2+
p(2,5)**2)
11751 20 psave(3,i,j)=
p(i,j)
11753 parl(21)=2.*(dble(
p(1,4))*dble(
p(2,4))-dble(
p(1,3))*dble(
p(2,3)))
11754 roots=
sqrt((dble(
p(1,4))+dble(
p(2,4)))**2
11755 + -(dble(
p(1,3))+dble(
p(2,3)))**2)
11756 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10000)
11757 +lepin,(
p(1,j),j=1,3),parl(1),parl(2),(
p(2,j),j=1,3),inter,roots
11758 IF(plz*ppz.GT.0.1)
THEN
11763 IF(psave(3,1,3).LT.0.)
THEN
11771 dbeta(1,3)=(dble(
p(1,3))+dble(
p(2,3)))/(dble(
p(1,4))+dble(
p(2,4)))
11774 IF(lst(17).NE.0)
THEN
11776 CALL ludbrb(0,0,0.,0.,0.d0,0.d0,-
dbeta(1,3))
11778 CALL ludbrb(0,0,0.,-sphi(1),0.d0,0.d0,0.d0)
11780 CALL ludbrb(0,0,-stheta(1),0.,0.d0,0.d0,0.d0)
11787 cut(1)=max(cut(1),0.)
11788 cut(2)=min(cut(2),1.)
11789 cut(3)=max(cut(3),0.)
11790 cut(4)=min(cut(4),1.)
11791 cut(5)=max(cut(5),0.)
11792 cut(6)=min(cut(6),
s)
11793 cut(7)=max(cut(7),0.)
11794 cut(8)=min(cut(8),
s)
11795 cut(9)=max(cut(9),0.)
11796 cut(10)=min(cut(10),
s/(2.*
p(2,5)))
11808 IF(lst(32).NE.0)
THEN
11809 xmin=max(
xmin,q2min/(
s*ymax),q2min/(2.*
p(2,5)*cut(10)),
11810 + 1.-(w2max-pm2)/max(
s*ymin,1.
e-22), 1.-(w2max-pm2)/max(2.*
p(2,
11814 xmincmp=max(
xmin,q2min/(
s*ymax),q2min/(2.*
p(2,5)*cut(10)),
11815 + 1.-(w2max-pm2)/max(
s*ymin,1.
e-22), 1.-(w2max-pm2)/max(2.*
p(2,
11819 xmin=max(
xmin,q2min/(
s*ymax),q2min/(2.*
p(2,5)*cut(10)),
11820 + 1.-(w2max-pm2)/max(
s*ymin,1.
e-22), 1.-(w2max-pm2)/max(2.*
p(2,
11823 xmax=min(
xmax,q2max/max(
s*ymin,1.
e-22), q2max/max(2.*
p(2,5)*
11824 + umin,1.
e-22), 1.-(w2min-pm2)/(
s*ymax),1.-(w2min-pm2)/(2.*
p(2,5)
11826 ymin=max(ymin,q2min/(
s*
xmax),(w2min-pm2)/(
s*(1.-
xmin)), (w2min-
11827 + pm2+q2min)/
s,2.*
p(2,5)*umin/
s)
11828 ymax=min(ymax,q2max/max(
s*
xmin,1.
e-22), (w2max-pm2)/max(
s*(1.-
11829 +
xmax),1.
e-22), (w2max-pm2+q2max)/
s,2.*
p(2,5)*umax/
s)
11830 q2min=max(q2min,
s*
xmin*ymin,
s*ymin-w2max+pm2, 2.*
p(2,5)*umin*
11832 q2max=min(q2max,
s*
xmax*ymax,
s*ymax-w2min+pm2, 2.*
p(2,5)*umax*
11834 w2min=max(w2min,
s*(1.-
xmax)*ymin+pm2,q2min*(1.-
xmax)/
xmax+pm2,
11835 +
s*ymin-q2max+pm2,2.*
p(2,5)*umin*(1.-
xmax)+pm2)
11836 w2max=min(w2max,
s*(1.-
xmin)*ymax+pm2, q2max*(1.-
xmin)/max(
xmin,
11837 + 1.
e-22)+pm2,
s*ymax-q2min+pm2,2.*
p(2,5)*umax*(1.-
xmin)+pm2)
11845 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10200)
11846 +cut,
xmin,
xmax,ymin,ymax,q2min,q2max,w2min,w2max,umin,umax
11847 IF(
xmax.LT.
xmin.OR.ymax.LT.ymin.OR.q2max.LT.q2min.OR.
11848 +w2max.LT.w2min)
THEN
11849 IF(lst(3).GE.1)
WRITE(6,10300)
11850 IF(lst(3).GE.2)
THEN
11857 pari(11)=(parl(1)-parl(2))/parl(1)
11860 IF(lepin.LT.0) ilep=2
11862 IF(iabs(lepin).EQ.12.OR.iabs(lepin).EQ.14.OR.
11863 +iabs(lepin).EQ.16) inu=1
11867 IF(lepin.LT.0) parl(6)=1.
11869 IF(lst(23).EQ.1.AND.inu.EQ.0)
THEN
11874 ELSEIF(lst(23).EQ.2)
THEN
11876 IF(ksave(1).LT.0.AND.parl(6).LT.-0.99
11877 + .OR.ksave(1).GT.0.AND.parl(6).GT.0.99)
THEN
11878 IF(lst(3).GE.1)
WRITE(6,10400) lepin,parl(6)
11879 IF(lst(3).GE.2)
THEN
11884 IF(
mod(iabs(lepin),2).EQ.0)
THEN
11885 ksave(3)=isign(24,lepin)
11886 ksave(4)=isign(iabs(lepin)-1,lepin)
11888 ksave(3)=isign(24,-lepin)
11889 ksave(4)=isign(iabs(lepin)+1,lepin)
11891 ELSEIF(lst(23).EQ.3.OR.(lst(23).EQ.4.AND.inu.EQ.1))
THEN
11896 ELSEIF(lst(23).EQ.4.AND.inu.EQ.0)
THEN
11902 IF(lst(3).GE.1)
WRITE(6,10500) inter,lepin
11903 IF(lst(3).GE.2)
THEN
11910 IF(lst(1).EQ.0)
THEN
11912 IF(inter.EQ.2.OR.inter.EQ.3) lst(31)=2
11914 lst(31)=iabs(lst(1))
11916 IF(lst(31).LT.1.OR.lst(31).GT.3)
THEN
11917 IF(lst(3).GE.1)
WRITE(6,10600) lst(1),lst(31)
11918 IF(lst(3).GE.2)
THEN
11923 IF(lst(1).LT.0)
THEN
11925 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10700)
11926 + optx,opty,optq2,optw2
11934 IF(inter.EQ.1)
THEN
11939 ELSEIF(inter.EQ.4)
THEN
11964 IF(lst(23).EQ.2)
THEN
11966 pari(31)=parl(17)**2/pi*0.39
e+09
11969 pari(31)=2.*pi*parl(16)**2*0.39
e+09
11971 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10800)
11972 +(i,lst(i),lst(i+10),parl(i),parl(i+10),i=1,10)
11975 lqcd=
mod(lst(11),10)
11976 ltm=
mod(lst(11)/10,10)
11977 IF(inter.EQ.1.AND.lst(11).NE.0) CALL
fltabl
11981 IF(lst(10).GT.0) CALL
lxsect
11982 IF(lqcd.EQ.2.OR.ltm.EQ.2)
THEN
11984 IF(lqcd.EQ.2)
WRITE(6,11000)
11985 IF(ltm .EQ.2)
WRITE(6,11100)
11989 IF(lst(2).EQ.1)
THEN
11995 IF(lst(31).EQ.1)
THEN
11996 ukin(2)=(q2max+q2min)/2.
11997 wkin(2)=0.8*(q2max-q2min)/2.
12001 ELSEIF(lst(31).EQ.2)
THEN
12002 ukin(2)=(ymax+ymin)/2.
12003 wkin(2)=0.8*(ymax-ymin)/2.
12007 ELSEIF(lst(31).EQ.3)
THEN
12008 ukin(2)=(w2max+w2min)/2.
12009 wkin(2)=0.8*(w2max-w2min)/2.
12019 pari(lst(23))=fcnmax*1.5
12020 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,11300)
12021 + pari(lst(23)),ti2-ti1
12024 IF(lfile.GT.0)
THEN
12026 READ(lfile) lstw,parlw,nxx,nww,np,
xx,ww
12028 IF(lstw(17).NE.0) ipmax=3
12029 READ(lfile) (((pqg(ix,iw,ip),ix=1,nxx),iw=1,nww),ip=1,np),
12030 + (((pqqb(ix,iw,ip),ix=1,nxx),iw=1,nww),ip=1,np),
12031 + (((qgmax(ix,iw,ip),ix=1,nxx),iw=1,nww),ip=1,ipmax),
12032 + (((qqbmax(ix,iw,ip),ix=1,nxx),iw=1,nww),ip=1,min(2,ipmax)),
12034 IF(np.NE.1)
READ(lfile) xtot
12044 IF(lst(12).NE.lstw(12).OR.lst(13).NE.lstw(13)
12045 + .OR.lst(15).NE.lstw(15).OR.lst(16).NE.lstw(16)
12046 + .OR.lst(17).NE.lstw(17).OR.lst(23).NE.lstw(23)
12047 + .OR.abs(parl(1)-parlw(1)).GT.0.1.OR.abs(parl(2)-parlw(2)).GT.0.1
12048 + .OR.abs(parl(5)-parlw(5)).GT.0.01
12049 + .OR.abs(parl(6)-parlw(6)).GT.0.1)
THEN
12050 IF(lst(3).GE.1)
WRITE(6,11400) lst(12),lstw(12),lst(13),
12051 + lstw(13),lst(15), lstw(15),lst(16),lstw(16),lst(17),lstw(17),
12052 + lst(23),lstw(23), parl(1),parlw(1),parl(2),parlw(2),parl(5),
12053 + parlw(5),parl(6), parlw(6)
12054 IF(lst(3).GE.2)
THEN
12059 ELSEIF(lst(8).EQ.1.OR.lst(8)/10.EQ.1.OR.
mod(lst(8),10).EQ.9)
THEN
12064 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,11500)
12076 10000
FORMAT(
'1',//,5
x,
'THE LUND MONTE CARLO FOR DEEP INELASTIC LEPTON-'
12077 +,
'NUCLEON SCATTERING',/,5
x,65(
'='),//,
12078 +25
x,
'LEPTO VERSION 6.1, MAY 4, 1992',//,
12079 +
' LEPTON: TYPE =',i3,5
x,
'MOMENTUM (PX,PY,PZ) =',3f8.1,
12080 +
' GEV',//,
' TARGET: A, Z =',2
f3.0,2
x,
12081 +
'MOMENTUM (PX,PY,PZ) =',3f8.1,
' GEV',//,
12082 +
' INTERACTION :',i3,14
x,
' CMS ENERGY =',1pg12.4,
' GEV',/)
12083 10100
FORMAT(
' WARNING: LEPTON AND NUCLEON MOMENTA IN SAME DIRECTION',
12084 +
' NOT ALLOWED.',/,10
x,
'EXECUTION STOPPED.')
12085 10200
FORMAT(/,
' USER APPLIED CUTS (+ PHASE SPACE) : ',1
p,
12086 + g12.4,
' < X < ',g12.4,
12087 +/,37
x,g12.4,
' < Y < ',g12.4,
12088 +/,37
x,g12.4,
' < Q**2 < ',g12.4,
12089 +/,37
x,g12.4,
' < W**2 < ',g12.4,
12090 +/,37
x,g12.4,
' < NU < ',g12.4,
12091 +/,37
x,g12.4,
' < E'' < ',g12.4,
12092 +/,37
x,g12.4,
' < THETA < ',g12.4,/,
12093 +/,
' EFFECTIVE RANGES (FROM ABOVE CUTS): ',
12094 + g12.4,
' < X < ',g12.4,
12095 +/,37
x,g12.4,
' < Y < ',g12.4,
12096 +/,37
x,g12.4,
' < Q**2 < ',g12.4,
12097 +/,37
x,g12.4,
' < W**2 < ',g12.4,
12098 +/,37
x,g12.4,
' < NU < ',g12.4)
12099 10300
FORMAT(
' WARNING: EFFECTIVE UPPER LIMIT OF KINEMATICAL ',
12100 +
'VARIABLE(S) SMALLER THAN CORRESPONDING LOWER LIMIT.')
12101 10400
FORMAT(
' WARNING: WEAK CHARGED CURRENT CROSS SECTION ZERO FOR ',
12102 +
'SPECIFIED LEPTON HELICITY; LEPIN, PARL(6) =',i3,f5.2)
12103 10500
FORMAT(
' WARNING: UNRECOGNIZED INTERACTION IN LINIT CALL: ',
12104 +
'INTER = ',i5,
' FOR LEPTON LEPIN =',i5)
12105 10600
FORMAT(
' WARNING: UNALLOWED VALUE OF LST(1) =',i3,
12106 +
' AND/OR LST(31) =',i3)
12107 10700
FORMAT(/,
' USER-DEFINED OPTIMIZATION PARAMETERS:',
12108 +/,5
x,
'OPTX(1...4) =',4g11.3,/,5
x,
'OPTY(1...4) =',4g11.3,
12109 +/,5
x,
'OPYQ2(1...4) =',4g11.3,/,5
x,
'OPTW2(1...4) =',4g11.3,/)
12110 10800
FORMAT(/,
' PARAMETER VALUES:',//,9
x,
'I',4
x,
'LST(I)',1
x,
12111 +
'LST(I+10)',8
x,
'PARL(I)',5
x,
'PARL(I+10)',1
p,
12112 +/,5
x,55(
'-'),10(/,3i10,2g15.4),/)
12113 10900
FORMAT(
' WARNING: CROSS SECTION, PARL(23), EXCLUDES FL (SEE ',
12115 11000
FORMAT(10
x,
'QCD, SINCE EVALUATED EVENT BY EVENT FOR LQCD=2')
12116 11100
FORMAT(10
x,
'TM , SINCE EVALUATED EVENT BY EVENT FOR LTM =2')
12117 11200
FORMAT(
' CROSS SECTION IN PARL(24) INCLUDES THESE CONTRIBUTIONS.')
12118 11300
FORMAT(
' MAX OF DIFFERENTIAL CROSS SECTION (FOR WEIGHTING) =',
12119 +e12.4,/,
' OBTAINED IN ',f7.2,
' SECONDS.',/)
12120 11400
FORMAT(//,
' WARNING: CURRENT PARAMETER VALUES DO NOT MATCH ',
12121 +
'WITH THOSE USED WHEN CALCULATING QCD WEIGHTS.',//,15
x,
12122 +
'CURRENT VALUE VALUE FOR WEIGHTS',/,
12123 +/,
' LST(12) ',i12,10
x,i12,
12124 +/,
' LST(13) ',i12,10
x,i12,
12125 +/,
' LST(15) ',i12,10
x,i12,
12126 +/,
' LST(16) ',i12,10
x,i12,
12127 +/,
' LST(17) ',i12,10
x,i12,
12128 +/,
' LST(23) ',i12,10
x,i12,
12129 +/,
' PARL(1) ',e12.4,10
x,e12.4,
12130 +/,
' PARL(2) ',e12.4,10
x,e12.4,
12131 +/,
' PARL(5) ',e12.4,10
x,e12.4,
12132 +/,
' PARL(6) ',e12.4,10
x,e12.4)
12133 11500
FORMAT(/,
' TIME FOR CALCULATING QCD WEIGHTS =',f5.1,
' SECONDS',/)
12134 11600
FORMAT(
' EXECUTION STOPPED ',/)
12151 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
12152 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
12153 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
12154 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
12155 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
12156 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
12157 COMMON /lboost/
dbeta(2,3),stheta(2),sphi(2),pb(5),phir
12158 DOUBLE PRECISION dtheta,dphi,
dbeta,de,dpz,dpt,detot
12163 u=(w2-
p(2,5)**2)/(2.*
p(2,5)*(1.-
x))
12169 parl(22)=
y*parl(21)
12171 u=parl(22)/(2.*
p(2,5))
12172 w2=parl(22)*(1.-
x)+
p(2,5)**2
12174 IF(
p(4,5)/
sqrt(parl(21)).LT.0.001)
THEN
12176 de=dble(
p(1,4))*(1.-dble(
y))+dble(
x)*dble(
y)*dble(abs(
p(2,3)))
12177 dpz=de-dble(
x)*dble(
y)*(dble(
p(2,4))+dble(abs(
p(2,3))))
12180 de=dble(
p(1,4))+(dble(abs(
p(2,3)))*(dble(q2)+dble(
p(4,5))**2)/
12181 + (2.d0*dble(
p(1,4)))-dble(parl(22))/2.d0)/
12182 + (dble(
p(2,4))+dble(abs(
p(2,3))))
12183 dpz=dble(
p(1,4))-(dble(
p(2,4))*(dble(q2)+dble(
p(4,5))**2)/
12184 + (2.d0*dble(
p(1,4)))+dble(parl(22))/2.d0)/
12185 + (dble(
p(2,4))+dble(abs(
p(2,3))))
12187 dpt=de**2-dpz**2-dble(
p(4,5))**2
12188 IF(dpt.LT.0.d0)
RETURN
12196 p(3,3)=dble(
p(1,3))-dpz
12197 p(3,4)=dble(
p(1,4))-de
12204 IF(
x.LT.cut(1).OR.
x.GT.cut(2))
RETURN
12205 IF(
y.LT.cut(3).OR.
y.GT.cut(4))
RETURN
12206 IF(q2.LT.cut(5).OR.q2.GT.cut(6))
RETURN
12207 IF(w2.LT.cut(7).OR.w2.GT.cut(8))
RETURN
12208 IF(u.LT.cut(9).OR.u.GT.cut(10))
RETURN
12209 IF(lst(17).EQ.0)
THEN
12211 IF(
p(4,4).LT.cut(11).OR.
p(4,4).GT.cut(12))
THEN
12212 WRITE(*,*)
'CUTTING TOO LOW LEPTON ENERGY',
p(4,4),cut(11)
12221 IF(lst(20).NE.0) goto 20
12228 CALL ludbrb(6,6,stheta(1),sphi(1),0.d0,0.d0,0.d0)
12230 IF(
p(6,4).LT.cut(11).OR.
p(6,4).GT.cut(12))
RETURN
12231 thetal=acos((psave(3,1,1)*
p(6,1)+psave(3,1,2)*
p(6,2)+
12232 + psave(3,1,3)*
p(6,3))
12233 + /
sqrt(psave(3,1,1)**2+psave(3,1,2)**2+psave(3,1,3)**2)/
12234 +
sqrt(
p(6,1)**2+
p(6,2)**2+
p(6,3)**2))
12236 IF(thetal.LT.cut(13).OR.thetal.GT.cut(14))
then
12260 COMMON /lminui/ xkin(4),ukin(4),wkin(4),ain(4),
bin(4),
12261 &maxfin,relup,relerr,reler2,fcnmax
12262 COMMON /lpflag/ lst3
12265 1/lmmine/ erp(30) ,ern(30)
12266 2/lmpari/
x(15) ,
xt(15) ,dirin(15) ,maxint ,npar
12267 3/lmpare/ u(30) ,werr(30) ,maxext ,nu
12268 4/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
12270 7/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
12271 7/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
12272 c/lmcasc/
y(16) ,jh ,jl
12273 f/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
12274 g/lmsimv/
p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
12275 j/lmvart/ vt(15,15)
12277 6/lmunit/ isysrd ,isyswr ,isyspu
12278 8/lmtitl/
title(13),date(2) ,isw(7) ,nblock
12279 9/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
12280 a/lmcard/ cword ,cword2 ,cword3 ,word7(7)
12281 b/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
12282 fval3 = 2.0*amin+1.0
12284 word7(1)=relup*abs(amin)
12286 IF (up .LE. 0.) up = 1.0
12287 IF (isw(2) .GE. 1) CALL
lmprin(1,amin)
12290 nfcnmx = word7(1) + 0.5
12291 IF (nfcnmx .LE. 0) nfcnmx = 1000
12293 IF (epsi .LE. 0.) epsi = 0.1 * up
12298 IF(abs(dirin(1)).LE.abs(epsmac*
x(1)).AND.
12299 + abs(dirin(2)).LE.abs(epsmac*
x(2)))
THEN
12300 IF(lst3.GE.1)
WRITE(6,10000)
12304 relerr=reler2*relerr
12306 nfcnmx = word7(1) + 0.5
12307 IF (nfcnmx .LE. 0) nfcnmx = 1000
12309 IF (epsi .LE. 0.) epsi = 0.1 * up
12311 10 fcnmax=abs(amin)
12312 IF(isw(1).GE.1)
THEN
12313 IF(lst3.GE.1)
WRITE(6,10100)
12319 20 it = word7(1) + 0.5
12320 IF (fval3 .EQ. amin .OR. it .GT. 0)
RETURN
12322 CALL
lsigmx(npar,gin,
f,u,iflag)
12324 IF(lst3.GE.1.AND.abs(
f).GT.fmax)
WRITE(6,10200)
f
12327 10000
FORMAT(
' WARNING: STEPSIZES ARE LESS THAN MACHINE ACCURACY ',
12328 &
'TIMES VARIABLE VALUES. NO FURTHER MINIMIZATION ATTEMPTED.')
12329 10100
FORMAT(
' WARNING: SIMPLEX MINIMIZATION HAS NOT CONVERGED ',
12330 &
'PROPERLY.',/,10
x,
'RETURNED MAXIMUM INCREASED BY A FACTOR 1.25.')
12331 10200
FORMAT(
' WARNING FROM LMCMND: FUNCTION AT MINIMUM, ',e12.4,
12332 &
' IS SMALLER THAN STORED MINIMUM.')
12344 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
12345 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
12346 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
12347 COMMON /lboost/
dbeta(2,3),stheta(2),sphi(2),pb(5),phir
12348 COMMON /pypara/ ipy(80),pypar(80),pyvar(80)
12349 COMMON /pyproc/ isub,kfl(3,2),xpy(2),sh,th,uh,q2py,xsec(0:40)
12350 COMMON /pyint1/ xqpy(2,-6:6)
12351 DOUBLE PRECISION dtheta,dphi,
dbeta
12352 DOUBLE PRECISION dpq2,dpb(3),dpa(3),dcthet,drobo(5)
12353 dimension ks(9,5),ps(9,5),robo(5),xpq(-6:6)
12365 IF(lst(24).EQ.3) ip2=7
12380 20
p(10,j)=ps(ip2,j)
12392 40
p(6,j)=
p(8,j)+
p(10,j)-
p(5,j)
12395 IF(lst(24).EQ.3) k(6,2)=21
12416 60
p(
ns+6,j)=
p(10,j)
12432 IF(k(
ns+6,2).EQ.21)
THEN
12434 IF(k(
ns+5,2).GT.0)
THEN
12435 k(
ns+5,4)=(
ns+6)*mstu(5)
12436 k(
ns+5,5)=(
ns+7)*mstu(5)
12437 k(
ns+6,4)=(
ns+7)*mstu(5)
12438 k(
ns+6,5)=(
ns+5)*mstu(5)
12440 k(
ns+5,4)=(
ns+7)*mstu(5)
12441 k(
ns+5,5)=(
ns+6)*mstu(5)
12442 k(
ns+6,4)=(
ns+5)*mstu(5)
12443 k(
ns+6,5)=(
ns+7)*mstu(5)
12447 k(
ns+5,4)=(
ns+7)*mstu(5)
12448 k(
ns+5,5)=(
ns+7)*mstu(5)
12449 k(
ns+6,4)=(
ns+7)*mstu(5)
12450 k(
ns+6,5)=(
ns+7)*mstu(5)
12455 IF(lst(24).EQ.2)
THEN
12456 k(
ns+7,2)=k(
ns+5,2)
12457 IF(k(
ns+7,2).EQ.21)
WRITE(6,*)
' WARNING: K(NS+7,2)=',k(
ns+7,2)
12458 IF(k(
ns+7,2).GT.0)
THEN
12459 k(
ns+7,4)=(
ns+3)*mstu(5)+26
12460 k(
ns+7,5)=(
ns+3)*mstu(5)+25
12462 k(
ns+7,4)=(
ns+3)*mstu(5)+25
12463 k(
ns+7,5)=(
ns+3)*mstu(5)+26
12467 IF(k(
ns+5,2).GT.0)
THEN
12468 k(
ns+7,4)=(
ns+3)*mstu(5)+25
12469 k(
ns+7,5)=(
ns+3)*mstu(5)+26
12471 k(
ns+7,4)=(
ns+3)*mstu(5)+26
12472 k(
ns+7,5)=(
ns+3)*mstu(5)+25
12476 70
p(
ns+7,j)=
p(8,j)+
p(10,j)
12489 CALL
pystfu(k(2,2),xr,q2,xpq)
12491 80 xqpy(2,ifl)=xpq(ifl)
12492 IF(lst(23).EQ.1)
THEN
12495 ELSEIF(lst(23).EQ.3)
THEN
12498 ELSEIF(lst(23).EQ.4)
THEN
12501 ELSEIF(lst(23).EQ.2)
THEN
12504 IF(isub.EQ.39.AND.ipy(11).EQ.1)
THEN
12506 ELSEIF(isub.EQ.39.AND.ipy(11).EQ.2)
THEN
12508 ELSEIF(isub.EQ.39.AND.ipy(11).EQ.3)
THEN
12510 ELSEIF(isub.EQ.40)
THEN
12516 IF(isub.EQ.39) kfl(3,1)=k(1,2)
12517 IF(isub.EQ.40) kfl(3,1)=k(1,2)+isign(1,k(1,2))
12520 pyvar(1)=
sqrt(pyvar(2))
12523 pyvar(5)=pyvar(1)/2.
12529 IF(ipy(13).EQ.1)
THEN
12541 IF(xpy(2)*(1.+(
p(it,5)**2+pypar(22))/
p(21,5)**2).GT.0.999)
THEN
12545 IF(ipy(14).GE.1)
THEN
12557 100
p(
ns+1,j)=
p(21,j)
12565 p(
ns+3,3)=(
p(it,5)**2+q2)*(
p(21,4)-
p(21,3))/(2.*q2)
12573 k(23,4)=k(23,4)+(
ns+3)*mstu(5)
12574 k(23,5)=k(23,5)+(
ns+3)*mstu(5)
12586 IF(
p(
n+1,4).LE.1.01*
p(it,5))
THEN
12592 CALL ludbrb(25,
ns,0.,-robo(2),0.d0,0.d0,0.d0)
12593 CALL ludbrb(25,
ns,-robo(1),0.,0.d0,0.d0,0.d0)
12594 drobo(5)=-(
p(it,3)*
p(it,4)-
p(
n+1,4)*
sqrt(
p(
n+1,4)**2-
12595 +
p(it,4)**2+
p(it,3)**2))/(
p(it,3)**2+
p(
n+1,4)**2)
12596 CALL ludbrb(25,
ns,0.,0.,0.d0,0.d0,drobo(5))
12599 CALL ludbrb(25,
ns,robo(1),robo(2),0.d0,0.d0,0.d0)
12607 IF(ipy(48).EQ.1)
THEN
12616 IF(mstu(24).NE.0)
THEN
12618 IF(lst(3).GE.1)
WRITE(6,*)
' LUPREP ERROR MSTU(24)= ',mstu(24)
12632 120
p(
n+1,j)=
p(4,j)
12669 IF(k(
ns+1,2).EQ.k(3,2)) k(
ns+1,1)=0
12672 IF(k(i,1).LT.0)
THEN
12680 IF(
mod(lst(4)/10,10).EQ.0)
THEN
12710 +/lmmine/ erp(30) ,ern(30)
12711 +/lmpari/
x(15) ,
xt(15) ,dirin(15) ,maxint ,npar
12712 +/lmpare/ u(30) ,werr(30) ,maxext ,nu
12713 +/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
12715 +/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
12716 +/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
12717 +/lmcasc/
y(16) ,jh ,jl
12718 +/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
12719 +/lmsimv/
p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
12720 +/lmvart/ vt(15,15)
12722 +/lmunit/ isysrd ,isyswr ,isyspu
12723 +/lmtitl/
title(13),date(2) ,isw(7) ,nblock
12724 +/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
12725 +/lmcard/ cword ,cword2 ,cword3 ,word7(7)
12726 +/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
12727 COMMON /lminui/ xkin(4),ukin(4),wkin(4),ain(4),
bin(4),
12728 +maxfin,relup,relerr,reler2,fcnmax
12729 COMMON /lminuc/ namkin(4),nam(30)
12730 COMMON /lpflag/ lst3
12731 CHARACTER*10 namkin,nam,namk,blank
12732 CHARACTER xtitle*60
12735 DATA xtitle/
' FIND MINIMUM OF -(DIFFERENTIAL CROSS SECTION)'/
12736 DATA mninit/0/,ifatal,
nint/0,0/
12743 IF (mninit .EQ. 0) nblock=0
12745 nblock = nblock + 1
12748 WRITE (isyswr,10200) maxint,maxext,versn,nblock
12749 WRITE (isyswr,10300)
12756 WRITE (isyswr,11200) xtitle,time,epsmac
12757 WRITE (isyswr,10300)
12764 IF(lst3.GE.5)
WRITE (isyswr,10300)
12778 IF(i.GE.5) goto 160
12787 IF (k .LE. 0) go to 160
12788 IF (k .LE. maxext) go to 30
12789 ifatal = ifatal + 1
12791 WRITE (isyswr,10700) k,maxext
12792 WRITE (isyswr,10000) k,namk,uk,wk,
a,b
12796 IF(nam(k).EQ.blank) go to 40
12798 IF(lst3.GE.1)
WRITE(isyswr,10500)
12804 IF (wk .GT. 0.0) go to 50
12806 IF(lst3.GE.5)
WRITE (isyswr, 10000) k,namk,uk
12810 50
IF(lst3.GE.5)
WRITE (isyswr, 10000) k,namk,uk,wk,
a,b
12814 60
IF (b) 80 ,70 ,80
12817 80
IF (b-
a) 100,90 ,110
12818 90 ifatal = ifatal + 1
12819 IF(lst3.GE.1)
WRITE (isyswr,10800)
12824 IF(lst3.GE.1)
WRITE (isyswr,10100)
12828 IF ((b-u(k))*(u(k)-
a)) 120,130,140
12829 120 ifatal = ifatal + 1
12830 IF(lst3.GE.1)
WRITE (isyswr,10900)
12832 130
IF(lst3.GE.1)
WRITE (isyswr,10400)
12835 ifatal = ifatal + 1
12836 IF(lst3.GE.1)
WRITE (isyswr,11000)
12839 160
IF(lst3.GE.5)
WRITE (isyswr,10300)
12840 IF (
nint .LE. maxint) go to 170
12841 IF(lst3.GE.1)
WRITE (isyswr,10600)
nint,maxint
12842 ifatal = ifatal + 1
12843 170
IF (ifatal .LE. 0) go to 180
12844 IF(lst3.GE.1)
WRITE (isyswr,11100) ifatal
12849 IF (lcode(k) .LE. 0) go to 190
12855 sav2 = sav + werr(k)
12856 vplu =
lmpint(sav2,k) -
x(npar)
12857 sav2 = sav - werr(k)
12858 vminu =
lmpint(sav2,k) -
x(npar)
12859 dirin(npar) = 0.5 * (abs(vplu) +abs(vminu))
12860 g2(npar) = 2.0 / dirin(npar)**2
12861 gstep(npar) = dirin(npar)
12862 IF (lcode(k) .GT. 1) gstep(npar) = -gstep(npar)
12868 10000
FORMAT (i10,2
x,a10,2
x,2g12.6,2
x,2g12.6)
12869 10100
FORMAT(
' WARNING - ABOVE LIMITS HAVE BEEN REVERSED.')
12870 10200
FORMAT (1
h1/42
x,21(1h*)/42
x,21h* d506 minuit */42
x,
12871 +12h* dimensions, i3, 1h/, i3, 2h */ 42
x,
12872 +
'* MODIFICATION OF *',/,42
x,
12874 10300
FORMAT (4
x,96(1h*))
12875 10400
FORMAT(
' WARNING - ABOVE PARAMETER IS AT LIMIT ')
12876 10500
FORMAT(
' WARNING ******* - PARAMETER REQUESTED ON FOLLOWING',
12877 +
' CARD HAS ALREADY APPEARED. PREVIOUS VALUES IGNORED.')
12878 10600
FORMAT(
'0 TOO MANY VARIABLE PARAMETERS. YOU REQUEST',i5/,
12879 +
' THIS VERSION OF MINUIT IS ONLY DIMENSIONED FOR',i4//)
12880 10700
FORMAT(
'0FATAL ERROR. PARAMETER NUMBER',i11,
' GREATER THAN ',
12881 +
'ALLOWED MAXIMUM',i4)
12882 10800
FORMAT(
' FATAL ERROR. UPPER AND LOWER LIMITS ARE EQUAL.')
12883 10900
FORMAT(
' FATAL ERROR. PARAMETER OUTSIDE LIMITS',/)
12884 11000
FORMAT(
'0FATAL ERROR. MORE THAN 200 PARAMETER CARDS',/)
12885 11100
FORMAT(/i5,
' FATAL ERRORS ON PARAMETER CARDS. ABORT.',//)
12886 11200
FORMAT(5
x,a60,5
x,
'TIME',f8.3,
' SECONDS',/,70
x,
'MACH. PREC.=',
12905 COMMON /lpflag/ lst3
12907 +/lmmine/ erp(30) ,ern(30)
12908 +/lmpari/
x(15) ,
xt(15) ,dirin(15) ,maxint ,npar
12909 +/lmpare/ u(30) ,werr(30) ,maxext ,nu
12910 +/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
12912 +/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
12913 +/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
12914 +/lmcasc/
y(16) ,jh ,jl
12915 +/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
12916 +/lmsimv/
p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
12917 +/lmvart/ vt(15,15)
12919 +/lmunit/ isysrd ,isyswr ,isyspu
12920 +/lmtitl/
title(13),date(2) ,isw(7) ,nblock
12921 +/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
12922 +/lmcard/ cword ,cword2 ,cword3 ,word7(7)
12923 +/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
12935 epsmac = epsmac * 0.5
12936 IF ((1.0+epsmac) .EQ. 1.0) go to 20
12939 20 epsmac = 2.0 * epsmac
12945 IF(lst3.GE.5)
WRITE (isyswr,10000)
12946 10000
FORMAT (/,
'0FIRST ENTRY TO FCN ')
12947 CALL
lsigmx(npar,gin,amin,u,1)
12948 CALL
lsigmx(npar,gin,amin,u,4)
12951 IF (
f .NE. amin) go to 40
12956 IF(lst3.GE.1)
WRITE (isyswr,10100) amin,
f
12958 10100
FORMAT(
'0FOR THE ABOVE VALUES OF THE PARAMETERS, FCN IS TIME-',
12959 +
'DEPENDENT',/,
'0F = ',e22.14,
' FOR FIRST CALL',/,
' F =',e22.14,
12976 +/lmmine/ erp(30) ,ern(30)
12977 +/lmpari/
x(15) ,
xt(15) ,dirin(15) ,maxint ,npar
12978 +/lmpare/ u(30) ,werr(30) ,maxext ,nu
12979 +/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
12981 +/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
12982 +/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
12983 +/lmcasc/
y(16) ,jh ,jl
12984 +/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
12985 +/lmsimv/
p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
12986 +/lmvart/ vt(15,15)
12988 +/lmunit/ isysrd ,isyswr ,isyspu
12989 +/lmtitl/
title(13),date(2) ,isw(7) ,nblock
12990 +/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
12991 +/lmcard/ cword ,cword2 ,cword3 ,word7(7)
12992 +/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
12997 IF ( j ) 30 ,30 ,10
12999 IF (lcode(i) .EQ. 1) go to 20
13001 u(i) = al + 0.5 *(
sin(pint(j)) +1.0) * (blim(i) -al)
13012 REAL FUNCTION lmpint(PEXTI,I)
13019 1/lmmine/ erp(30) ,ern(30)
13020 2/lmpari/
x(15) ,
xt(15) ,dirin(15) ,maxint ,npar
13021 3/lmpare/ u(30) ,werr(30) ,maxext ,nu
13022 4/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
13024 7/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
13025 7/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
13026 c/lmcasc/
y(16) ,jh ,jl
13027 f/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
13028 g/lmsimv/
p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
13029 j/lmvart/ vt(15,15)
13031 6/lmunit/ isysrd ,isyswr ,isyspu
13032 8/lmtitl/
title(13),date(2) ,isw(7) ,nblock
13033 9/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
13034 a/lmcard/ cword ,cword2 ,cword3 ,word7(7)
13035 b/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
13036 COMMON /lpflag/ lst3
13037 DATA big, small / 1.570796326795 , -1.570796326795 /
13039 go to(10 ,20 ,30 ,40 ),igo
13048 IF (pexti-alimi) 50 ,100,70
13051 pexti = alimi + 0.5* (blimi-alimi) *(
sin(
a) +1.0)
13053 IF(lst3.GE.1)
WRITE (isyswr,10000) i
13055 70
IF (blimi-pexti) 80 ,110,90
13058 90
yy=2.0*(pexti-alimi)/(blimi-alimi) - 1.0
13065 10000
FORMAT(
' WARNING - VARIABLE',i3,
' HAS BEEN BROUGHT BACK IN',
13066 +
'SIDE LIMITS BY LMPINT.')
13074 SUBROUTINE lmprin (IKODE,FVAL)
13085 +/lmmine/ erp(30) ,ern(30)
13086 +/lmpari/
x(15) ,
xt(15) ,dirin(15) ,maxint ,npar
13087 +/lmpare/ u(30) ,werr(30) ,maxext ,nu
13088 +/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
13090 +/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
13091 +/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
13092 +/lmcasc/
y(16) ,jh ,jl
13093 +/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
13094 +/lmsimv/
p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
13095 +/lmvart/ vt(15,15)
13097 +/lmunit/ isysrd ,isyswr ,isyspu
13098 +/lmtitl/
title(13),date(2) ,isw(7) ,nblock
13099 +/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
13100 +/lmcard/ cword ,cword2 ,cword3 ,word7(7)
13101 +/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
13102 COMMON /lminuc/ namkin(4),nam(30)
13103 COMMON /lpflag/ lst3
13104 CHARACTER*10 namkin,nam
13107 IF(lst3.GE.5)
WRITE (isyswr,10000)
13112 IF(nam(i).EQ.
' ') goto 110
13114 IF (l .EQ. 0) go to 80
13116 IF (isw(2) .LT. 1) go to 30
13117 dx =
sqrt(abs(v(l,l)*up))
13118 IF (lcode(i) .LE. 1) go to 20
13121 du1 = al + 0.5 *(
sin(
x(l)+
dx) +1.0) * ba - u(i)
13122 du2 = al + 0.5 *(
sin(
x(l)-
dx) +1.0) * ba - u(i)
13123 IF (
dx .GT. 1.0) du1 = ba
13124 dx = 0.5 * (abs(du1) + abs(du2))
13128 IF (ikode .LT. 2) go to 40
13131 40
IF (kount) 50,50,60
13133 IF(lst3.GE.5)
WRITE (isyswr,10100) fval,nfcn,ti,
e, l,i,nam(i),
13134 + u(i),werr(i),
x1,
x2
13136 60
IF(lst3.GE.5)
WRITE (isyswr,10200) l,i,nam(i),u(i),werr(i),
x1,
13138 70
IF (lcode(i) .LE. 1) go to 110
13139 IF(lst3.GE.1.AND. abs(
cos(
x(l))) .LT. 0.001)
WRITE (isyswr,
13143 80
IF (ikode .EQ. 0) go to 110
13144 IF (kount) 90,90,100
13146 IF(lst3.GE.5)
WRITE (isyswr,10100) fval,nfcn,ti,
e, l,i,nam(i),
13149 100
IF(lst3.GE.5)
WRITE (isyswr,10300) i,nam(i),u(i)
13151 IF(lst3.GE.5.AND. ikode.GE.1 .AND.isw(2).GE.1)
WRITE (isyswr,
13154 10000
FORMAT(/ 4
x,
'FCN VALUE',5
x,
'CALLS',4
x,
'TIME',4
x,
' EDM ',4
x ,
13155 +
'INT.EXT. PARAMETER VALUE ERROR INTERN.VALUE ',
13157 10100
FORMAT(e15.7,i7,f9.2,e11.2,i6,i4,1
x,a10,4e14.5)
13158 10200
FORMAT(1h ,41
x,i6,i4,1
x,a10,4e14.5)
13159 10300
FORMAT(1h ,47
x ,i4,1
x,a10,4e14.5)
13160 10400
FORMAT(1h ,52
x ,
'WARNING - - ABOVE PARAMETER IS AT LIMIT.')
13161 10500
FORMAT(/45
x,
'ERRORS CORRESPOND TO FUNCTION CHANGE OF ',e12.4)
13170 SUBROUTINE lmrazz(YNEW,PNEW)
13178 +/lmmine/ erp(30) ,ern(30)
13179 +/lmpari/
x(15) ,
xt(15) ,dirin(15) ,maxint ,npar
13180 +/lmpare/ u(30) ,werr(30) ,maxext ,nu
13181 +/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
13183 +/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
13184 +/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
13185 +/lmcasc/
y(16) ,jh ,jl
13186 +/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
13187 +/lmsimv/
p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
13188 +/lmvart/ vt(15,15)
13190 +/lmunit/ isysrd ,isyswr ,isyspu
13191 +/lmtitl/
title(13),date(2) ,isw(7) ,nblock
13192 +/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
13193 +/lmcard/ cword ,cword2 ,cword3 ,word7(7)
13194 +/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
13195 COMMON /lpflag/ lst3
13200 IF(ynew.GE.amin) go to 30
13209 40
DO 50 j=2,nparp1
13210 IF (
y(j) .GT.
y(jh)) jh = j
13212 sigma =
y(jh) -
y(jl)
13213 IF (sigma .LE. 0.) go to 90
13219 IF (
p(i,j) .GT. pbig) pbig =
p(i,j)
13220 IF (
p(i,j) .LT. plit) plit =
p(i,j)
13222 dirin(i) = pbig - plit
13223 IF (itaur .LT. 1 ) v(i,i) = 0.5*(v(i,i) +us*dirin(i)**2)
13226 90
IF(lst3.GE.1.AND.
mod(itoo,10).EQ.0)
THEN
13227 WRITE (isyswr, 10000) npar
13231 10000
FORMAT(
'0***** FUNCTION VALUE DOES NOT SEEM TO DEPEND ON ANY ',
13232 +
'OF THE',i3,
' VARIABLE PARAMETERS',/15
x ,
'VERIFY THAT STEP SIZES',
13233 +
' ARE BIG ENOUGH AND CHECK FCN LOGIC.',/1
x,81(1h*)/1
x,81(1h*)//)
13247 COMMON /lminui/ xkin(4),ukin(4),wkin(4),ain(4),
bin(4),
13248 +maxfin,relup,relerr,reler2,fcnmax
13249 COMMON /lpflag/ lst3
13251 +/lmmine/ erp(30) ,ern(30)
13252 +/lmpari/
x(15) ,
xt(15) ,dirin(15) ,maxint ,npar
13253 +/lmpare/ u(30) ,werr(30) ,maxext ,nu
13254 +/lmlimi/ alim(30) ,blim(30) ,lcode(30) ,lcorsp(30) ,limset
13256 +/lmfix / ipfix(15),xs(15) ,xts(15) ,dirins(15) ,npfix
13257 +/lmfix2/ grds(15) ,g2s(15) ,gsteps(15),aberfs(15)
13258 +/lmcasc/
y(16) ,jh ,jl
13259 +/lmderi/ gin(30) ,grd(15) ,g2(15) ,gstep(15) ,aberf(15)
13260 +/lmsimv/
p(15,16) ,pstar(15),pstst(15) ,pbar(15) ,prho(15)
13261 +/lmvart/ vt(15,15)
13263 +/lmunit/ isysrd ,isyswr ,isyspu
13264 +/lmtitl/
title(13),date(2) ,isw(7) ,nblock
13265 +/lmconv/ epsi ,apsi ,vtest ,nstepq ,nfcn ,nfcnmx
13266 +/lmcard/ cword ,cword2 ,cword3 ,word7(7)
13267 +/lmmini/ amin ,up ,newmin ,itaur ,sigma,epsmac
13269 DATA alpha,
beta,
gamma,rhomin,rhomax / 1.0, 0.5, 2.0, 4.0, 8.0/
13276 IF (npar .LE. 0)
RETURN
13280 rho2 = rho1 + alpha*
gamma
13281 wg = 1.0/float(npar)
13283 IF(lst3.GE.5)
WRITE(isyswr,10000) epsi
13285 IF (isw(2) .GE. 1) dirin(i) =
sqrt(v(i,i)*up)
13286 IF (abs(dirin(i)) .LT. 1.0
e-10*abs(
x(i))) dirin(i)=1.0
e-8*
x(i)
13287 IF(itaur.LT. 1) v(i,i) = dirin(i)**2/up
13289 IF (itaur .LT. 1) isw(2) = 1
13303 30
x(i) = bestx + dirin(i)
13305 CALL
lsigmx(npar,gin,
f, u, 4)
13307 IF (
f .LE. aming) go to 40
13309 IF (kg .EQ. 1) go to 50
13312 dirin(i) = dirin(i) * (-0.4)
13313 IF (nf .LT. 3) go to 30
13317 dirin(i) = dirin(i) * 3.0
13321 IF (
ns .LT. 6) go to 30
13324 IF (aming .LT. absmin) jl = i
13325 IF (aming .LT. absmin) absmin = aming
13337 90
IF(abs(dirin(i)).LE.abs(epsmac*
x(i))) dirin(i)=4.*epsmac*
x(i)
13338 IF (isw(5) .GE. 1) CALL
lmprin(0,amin)
13339 sigma = sigma * 10.
13347 IF (sig2 .LT. epsi .AND. sigma.LT.epsi) go to 220
13349 IF ((nfcn-npfn) .GT. nfcnmx) go to 230
13353 DO 110 j= 1, nparp1
13354 110 pb = pb + wg *
p(i,j)
13355 pbar(i) = pb - wg *
p(i,jh)
13356 120 pstar(i)=(1.+alpha)*pbar(i)-alpha*
p(i,jh)
13358 CALL
lsigmx(npar,gin,ystar,u,4)
13360 IF(ystar.GE.amin) go to 190
13363 130 pstst(i)=
gamma*pstar(i)+(1.-
gamma)*pbar(i)
13365 CALL
lsigmx(npar,gin,ystst,u,4)
13368 y1 = (ystar-
y(jh)) * rho2
13369 y2 = (ystst-
y(jh)) * rho1
13371 IF (
rho .LT. rhomin) go to 160
13372 IF (
rho .GT. rhomax)
rho = rhomax
13374 140 prho(i) =
rho*pbar(i) + (1.0-
rho)*
p(i,jh)
13376 CALL
lsigmx(npar,gin,yrho, u,4)
13378 IF (yrho .LT.
y(jl) .AND. yrho .LT. ystst) go to 150
13379 IF (ystst .LT.
y(jl)) go to 170
13380 IF (yrho .GT.
y(jl)) go to 160
13382 150 CALL
lmrazz(yrho,prho)
13384 160
IF (ystst .LT.
y(jl)) go to 170
13385 CALL
lmrazz(ystar,pstar)
13387 170 CALL
lmrazz(ystst,pstst)
13389 IF (isw(5) .LT. 2) go to 100
13390 IF (isw(5) .GE. 3 .OR.
mod(ncycl, 10) .EQ. 0) CALL
lmprin(0,amin)
13393 190
IF (ystar .GE.
y(jh)) go to 200
13395 CALL
lmrazz(ystar,pstar)
13396 IF (jhold .NE. jh) go to 100
13398 200
DO 210 i=1,npar
13399 210 pstst(i)=
beta*
p(i,jh)+(1.-
beta)*pbar(i)
13401 CALL
lsigmx(npar,gin,ystst,u,4)
13403 IF(ystst.GT.
y(jh)) go to 20
13405 IF (ystst .LT. amin) go to 170
13406 CALL
lmrazz(ystst,pstst)
13409 220
IF(lst3.GE.5)
WRITE(isyswr,10100)
13411 230
IF(lst3.GE.5)
WRITE(isyswr,10200)
13413 240
DO 260 i=1,npar
13416 250 pb = pb + wg *
p(i,j)
13417 260 pbar(i) = pb - wg *
p(i,jh)
13419 CALL
lsigmx(npar,gin,ypbar,u,iflag)
13421 IF (ypbar .LT. amin) CALL
lmrazz(ypbar,pbar)
13423 IF (nfcnmx+npfn-nfcn .LT. 3*npar) go to 270
13424 IF (sigma .GT. 2.0*epsi) go to 20
13425 270 CALL
lmprin(1-itaur, amin)
13427 10000
FORMAT(
' START SIMPLEX MINIMIZATION ',8
x ,
'CON',
13428 +.LT.
'VERGENCE CRITERION -- ESTIMATED DISTANCE TO MINIMUM (EDM) ',
13430 10100
FORMAT(1h ,
'SIMPLEX MINIMIZATION HAS CONVERGED')
13431 10200
FORMAT(1h ,
'SIMPLEX TERMINATES WITHOUT CONVERGENCE')
13442 SUBROUTINE lnstrf(X,Q2,XPQ)
13447 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
13448 dimension xpq(-6:6)
13452 IF(pari(11).LE.1.
e-06)
RETURN
13456 xpq(1)=(1.-pari(11))*xdv+pari(11)*xuv + xpq(-1)
13457 xpq(2)=(1.-pari(11))*xuv+pari(11)*xdv + xpq(-2)
13468 SUBROUTINE lprikt(S,PT,PHI)
13483 SUBROUTINE lprwts(NSTEP)
13488 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
13489 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
13490 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
13491 COMMON /lgrid/ nxx,nww,
xx(20),ww(15),pqg(20,15,3),pqqb(20,15,2),
13492 +qgmax(20,15,3),qqbmax(20,15,2),ycut(20,15),xtot(20,15),np
13493 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
13494 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
13496 wmax=
sqrt(parl(21)+psave(3,1,5)**2+psave(3,2,5)**2)
13497 WRITE(6,10000) parl(11),lst(13),mstu(112),paru(112), parl(8),
13498 +parl(9),parl(12),parl(13)
13504 WRITE(6,10300) lst(19),nww,nxx,ww,
xx
13505 IF(wmax.GT.ww(nww))
WRITE(6,10400) wmax,ww(nww)
13509 DO 30 iw=1,nww,max(1,nstep)
13511 IF(lw.GT.0) goto 40
13512 IF(w.GT.wmax) lw=lw+1
13515 DO 20 ix=1,nxx,max(1,nstep)
13517 IF(lx.GT.0) goto 30
13518 u=(w2-psave(3,2,5)**2)/(2.*psave(3,2,5)*(1.-
x))
13519 q2=2.*psave(3,2,5)*u*
x
13521 pari(24)=(1.+(1.-
y)**2)/2.
13523 pari(26)=(1.-(1.-
y)**2)/2.
13525 IF(
y.GT.1.) lx=lx+1
13531 rqqb=pqqb(ix,iw,ip)
13533 rqg=rqg+pqg(ix,iw,ip)*pari(23+ip)/xtot(ix,iw)
13534 IF(ip.LT.3) rqqb=rqqb+pqqb(ix,iw,ip)*pari(23+ip)/xtot(ix,
13541 IF(lst(39).EQ.-91)
THEN
13548 WRITE(6,10600) w,
x,
y,q2,parl(25),ycut(ix,iw),rq,rqg,rqqb
13554 10000
FORMAT(
'1',/,5
x,
'SUMMARY OF QCD MATRIX ELEMENT INTEGRATION',
13555 + /,5
x,
'-----------------------------------------',//,
13556 +/,
' FOR GLUON RADIATION (QG-EVENT) AND BOSON-GLUON FUSION ',
13557 +
'(QQ-EVENT) PROBABILITY.',
13558 +//,
' REQUIRED PRECISION IN INTEGRATION, PARL(11) =',f8.4,
13559 +//,
' HEAVIEST FLAVOUR PRODUCED IN BOSON-GLUON FUSION, LST(13) =',
13560 +i5,//,
' ALPHA-STRONG PARAMETERS: # FLAVOURS, MSTU(112) =',i3,
13561 +
' QCD LAMBDA, PARU(112) =',f6.3,
' GEV',
13562 +//,
' CUTS ON MATRIX ELEMENTS:',
13563 +/,
' PARL(8), PARL(9), PARL(12), PARL(13) =',4f8.4,/)
13564 10100
FORMAT(
' LEPTON ENERGY NOT ALLOWED TO VARY IN SIMULATION.',/)
13565 10200
FORMAT(
' LEPTON ENERGY ALLOWED TO VARY IN SIMULATION, ',/,
13566 +
' Y IN TABLE BELOW CALCULATED ASSUMING MAX ENERGY.',/)
13567 10300
FORMAT(
' GRID CHOICE, LST(19) =',i3,5
x,
'# GRID POINTS IN W, X =',
13568 +2i5,/,
' W-VALUES IN ARRAY WW:',/,10f8.1,/,5f8.1,
13569 +/,
' X-VALUES IN ARRAY XX:',/,10f8.4,/,10f8.4,/)
13570 10400
FORMAT(
' MAX W OUTSIDE GRID, EXECUTION STOPPED ] WMAX, GRID-MAX ='
13572 10500
FORMAT(//,6
x,
'W',7
x,
'X',7
x,
'Y',8
x,
'Q**2',3
x,
'ALPHA',
13573 +5
x,
'CUT',2
x,
'Q-EVENT',1
x,
'QG-EVENT',1
x,
'QQ-EVENT',
13575 10600
FORMAT(f7.1,2f8.4,1pg12.3,0pf8.2,f8.4,3f9.4)
13583 SUBROUTINE lqcdpr(QG,QQB)
13588 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
13589 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
13590 COMMON /lgrid/ nxx,nww,
xx(20),ww(15),pqg(20,15,3),pqqb(20,15,2),
13591 +qgmax(20,15,3),qqbmax(20,15,2),ycut(20,15),xtot(20,15),np
13592 DATA nout,nabove/2*0/,nwarn/10/
13598 IF(ww(1).LT.6..AND.w.LT.ww(1))
RETURN
13599 IF(
x.GT.
xx(nxx))
RETURN
13602 IF(
x.LT.
xx(1).OR.
x.GT.
xx(nxx).OR.
13603 +w.LT.ww(1).OR.w.GT.ww(nww))
THEN
13607 IF(lst(3).GE.1.AND.nout.LE.nwarn)
WRITE(6,10000)
x,w,
13608 +
int(pari(29)),nwarn
13609 IF(
x.LT.
xx(1)) xp=
xx(1)
13610 IF(
x.GT.
xx(nxx)) xp=
xx(nxx)
13611 IF(w.LT.ww(1)) w=ww(1)
13612 IF(w.GT.ww(nww)) w=ww(nww)
13616 IF(lst(30).EQ.1) ih=2
13619 IF(xp.GT.
xx(ix+1)) goto 10
13622 IF(w.GT.ww(iw+1)) goto 20
13623 wd=(w-ww(iw))/(ww(iw+1)-ww(iw))
13624 xd=(xp-
xx(ix))/(
xx(ix+1)-
xx(ix))
13627 x1p=(pqg(ix+1,iw,ip)-pqg(ix,iw,ip))*xd+pqg(ix,iw,ip)
13628 x2p=(pqg(ix+1,iw+1,ip)-pqg(ix,iw+1,ip))*xd+pqg(ix,iw+1,ip)
13629 qgip=(x2p-x1p)*wd+x1p
13632 pari(15)=max(qgmax(ix,iw,ih),qgmax(ix+1,iw+1,ih), qgmax(ix+1,
13633 + iw,ih),qgmax(ix,iw+1,ih))
13635 qg=qg+pari(23+ip)*qgip
13636 pari(14+ip)=max(qgmax(ix,iw,ip),qgmax(ix+1,iw+1,ip), qgmax(ix
13637 + +1,iw,ip),qgmax(ix,iw+1,ip))
13639 IF(ip.EQ.3) goto 30
13640 x1p=(pqqb(ix+1,iw,ip)-pqqb(ix,iw,ip))*xd+pqqb(ix,iw,ip)
13641 x2p=(pqqb(ix+1,iw+1,ip)-pqqb(ix,iw+1,ip))*xd+pqqb(ix,iw+1,ip)
13642 qqbip=(x2p-x1p)*wd+x1p
13645 pari(18)=max(qqbmax(ix,iw,ih),qqbmax(ix+1,iw+1,ih), qqbmax(ix
13646 + +1,iw,ih),qqbmax(ix,iw+1,ih))
13648 qqb=qqb+pari(23+ip)*qqbip
13649 pari(17+ip)=max(qqbmax(ix,iw,ip),qqbmax(ix+1,iw+1,ip),
13650 + qqbmax(ix+1,iw,ip),qqbmax(ix,iw+1,ip))
13656 x1p=(xtot(ix+1,iw)-xtot(ix,iw))*xd+xtot(ix,iw)
13657 x2p=(xtot(ix+1,iw+1)-xtot(ix,iw+1))*xd+xtot(ix,iw+1)
13658 pq17=(x2p-x1p)*wd+x1p
13664 parl(27)=max(ycut(ix,iw),ycut(ix+1,iw+1),
13665 +ycut(ix+1,iw),ycut(ix,iw+1))
13670 IF(lst(39).EQ.-91)
THEN
13676 IF(qg+qqb.GT.1)
THEN
13680 IF(lst(3).GE.1.AND.nabove.LE.nwarn)
WRITE(6,10100) qg,qqb,
x,w,
13681 +
int(pari(29)),nwarn
13687 10000
FORMAT(
' WARNING: X=',f7.4,
' OR W=',f6.1,
' OUTSIDE QCD GRID',
13688 +
' IN EVENT NO.',i8,/,10
x,
13689 +
'WEIGHT ON LIMIT OF GRID USED. ONLY FIRST',i5,
' WARNINGS PRINTED')
13690 10100
FORMAT(
' WARNING: SUM OF QCD PROBABILITIES LARGER THAN UNITY ',
13691 +
' QG, QQB =',2f8.4,/10
x,
'OCCURS AT X, W =',f8.4,f6.1,
13692 +
' IN EVENT NO.',i8,/,10
x,
13693 +
'WEIGHTS RESCALED TO UNIT SUM. ONLY FIRST',i5,
' WARNINGS PRINTED')
13707 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
13708 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
13709 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
13710 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
13711 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
13721 IF(ifail.NE.0) goto 30
13724 10 CALL
lflav(ifl,iflr)
13725 IF(lst(21).NE.0)
RETURN
13726 CALL
lzp(xp,zp,ifail)
13727 IF(ifail.NE.0) goto 30
13731 IF(lst(14).EQ.0.OR.iflr.GT.10
13732 +.OR.(lst(8).GE.2.AND.
mod(lst(8),10).NE.9))
THEN
13733 IF(w.LT.amifl+amiflr+parj(32)) goto 30
13734 IF(
lqmcut(xp,zp,amifl,0.,amiflr).NE.0) goto 30
13735 CALL
lu3ent(j1,ifl,21,iflr,w,pari(21),pari(23))
13741 IF(w.LT.amifl+amiflr+1.+parj(32)) goto 30
13742 IF(
lqmcut(xp,zp,amifl,0.,1.).NE.0) goto 30
13746 IF(nremh.GT.100) goto 30
13755 tmiflr=amiflr**2+pt2
13757 IF(
lqmcut(xp,zp,amifl,0.,
p(j3,5)).NE.0) goto 20
13759 CALL
lu3ent(j1,ifl,21,iflr,w,pari(21),pari(23))
13764 epz=
p(j3,4)-
p(j3,3)
13767 p(j3,3)=-0.5*((1.-
xt)*epz-tmiflr/(1.-
xt)/epz)
13768 p(j3,4)= 0.5*((1.-
xt)*epz+tmiflr/(1.-
xt)/epz)
13772 p(j4,3)=-0.5*(
xt*epz-tm2k2/
xt/epz)
13773 p(j4,4)= 0.5*(
xt*epz+tm2k2/
xt/epz)
13781 IF((
p(j3,4)+
p(j2,4)/2.)**2-(
p(j3,1)+
p(j2,1)/2.)**2-
p(j3,2)**2
13782 + -(
p(j3,3)+
p(j2,3)/2.)**2.LT.(amiflr+2.5*parj(32))**2) goto 20
13801 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
13802 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
13803 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
13804 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
13805 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
13811 10 CALL
lflav(ifl,iflr)
13812 IF(lst(21).NE.0) goto 10
13816 entry lqevar(iflar,iflrar)
13823 IF(lst(14).EQ.0.OR.iflr.GT.10
13824 +.OR.(lst(8).GE.2.AND.
mod(lst(8),10).NE.9))
THEN
13828 CALL
lu2ent(mstu(1),ifl,iflr,w)
13835 IF(w.LT.amifl+
ulmass(iflr)+0.9+parj(32)) goto 10
13839 IF(nremh.GT.100) goto 40
13847 ek2=.5*(
xt*w+tm2k2/
xt/w)
13848 pzk2=-.5*(
xt*w-tm2k2/
xt/w)
13850 wt=(1.-
xt)*w*epz-pt2
13852 IF(wt.LT.(amifl+amiflr+parj(32))**2) goto 30
13854 tmiflr=amiflr**2+pt2
13855 eifl=.5*(wt+(amifl**2-tmiflr)/wt)
13856 eiflr=.5*(wt+(-amifl**2+tmiflr)/wt)
13859 CALL
lu1ent(-mstu(1),ifl,eifl,0.,0.)
13860 CALL
lu1ent(mstu(1)+1,iflr,eiflr,ther,
phi)
13861 CALL ludbrb(mstu(1),0,0.,0.,0.d0,0.d0,
13862 + (dble(epz)-(1.d0-dble(
xt))*dble(w))/
13863 + (dble(epz)+(1.d0-dble(
xt))*dble(w)))
13867 p(mstu(1)+2,5)=amk2
13868 CALL
lu1ent(mstu(1)+2,k2,ek2,thek2,
phi+3.1415927)
13885 FUNCTION lqmcut(XP,ZP,AM1,AM2,AM3)
13890 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
13891 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
13892 DATA s12,s23,s13/3*0./
13894 IF(lst(24).EQ.2)
THEN
13896 s23=q2*(xp-
x)*(1.-zp)/
x/xp+am2**2+am3**2
13897 s13=q2*(xp-
x)*zp/
x/xp+am1**2+am3**2
13898 ELSEIF(lst(24).EQ.3)
THEN
13900 s23=q2*(xp-
x)*(1.-zp)/
x/xp+am2**2+am3**2
13901 s12=q2*(xp-
x)*zp/
x/xp+am1**2+am2**2
13902 IF(s13.LT.(am1+am3)**2) goto 10
13906 x1=1.-(s23-am1**2)/w2
13907 x3=1.-(s12-am3**2)/w2
13912 IF(
x1.GT.1..OR.
x2.GT.1..OR.x3.GT.1.) goto 10
13913 IF(
x1*w/2..LT.am1.OR.
x2*w/2..LT.am2.OR.x3*w/2..LT.am3) goto 10
13914 pa1=
sqrt((0.5*
x1*w)**2-am1**2)
13915 pa2=
sqrt((0.5*
x2*w)**2-am2**2)
13916 pa3=
sqrt((0.5*x3*w)**2-am3**2)
13917 IF(abs((pa3**2-pa1**2-pa2**2)/(2.*pa1*pa2)).GE.1.) goto 10
13918 IF(abs((pa2**2-pa1**2-pa3**2)/(2.*pa1*pa3)).GE.1.) goto 10
13936 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
13937 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
13938 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
13939 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
13940 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
13950 IF(ifail.NE.0) goto 50
13953 10 CALL
lflav(ifl1,ifl3)
13954 IF(lst(21).NE.0)
RETURN
13955 CALL
lzp(xp,zp,ifail)
13956 IF(ifail.NE.0) goto 50
13962 IF(lst(14).EQ.0.OR.(lst(8).GE.2.AND.
mod(lst(8),10).NE.9))
THEN
13965 IF(w.LT.amifl1+amifl3+parj(32)) goto 50
13966 IF(
lqmcut(xp,zp,amifl1,0.,amifl3).NE.0) goto 50
13967 CALL
lu3ent(j1,ifl1,21,ifl3,w,pari(21),pari(23))
13974 IF(w.LT.amifl1+amifl3+0.9+2.*parj(32)) goto 50
13975 IF(
lqmcut(xp,zp,amifl1,1.,amifl3).NE.0) goto 50
13980 iflr2=
int(1.+lst(22)/3.+
rlu(0))
13981 IF(iflr2.EQ.lst(22))
THEN
13983 IF(
rlu(0).GT.parl(4)) iflr1=2103
13985 iflr1=1000*iflr2+100*iflr2+3
13992 IF(nremh.GT.100) goto 50
13999 IF(
lqmcut(xp,zp,amifl1,
p(j2,5),amifl3).NE.0) goto 20
14001 CALL
lu3ent(j1,ifl1,21,ifl3,w,pari(21),pari(23))
14005 epz=
p(j2,4)-
p(j2,3)
14015 p(ir1,3)=-0.5*((1.-
xt)*epz-tm2r1/(1.-
xt)/epz)
14016 p(ir1,4)= 0.5*((1.-
xt)*epz+tm2r1/(1.-
xt)/epz)
14020 p(ir2,3)=-0.5*(
xt*epz-tm2r2/
xt/epz)
14021 p(ir2,4)= 0.5*(
xt*epz+tm2r2/
xt/epz)
14034 IF((
p(j1,4)+
p(j2,4))**2-(
p(j1,1)+
p(j2,1))**2-(
p(j1,3)+
p(j2,3))**2
14035 + -
p(j2,2)**2.LT.(
p(j1,5)+
p(j2,5)+parj(32))**2) goto 20
14036 IF((
p(j3,4)+
p(j4,4))**2-(
p(j3,1)+
p(j4,1))**2-(
p(j3,3)+
p(j4,3))**2
14037 + -
p(j4,2)**2.LT.(
p(j3,5)+
p(j4,5)+parj(32))**2) goto 20
14053 SUBROUTINE lremh(IFLRO,IFLR,K2,Z)
14059 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
14060 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
14063 IF(iflro.EQ.0) goto 20
14071 10 iflq=
int(1.+lst(22)/3.+
rlu(0))
14072 IF(iflq.EQ.lst(22))
THEN
14074 IF(
rlu(0).GT.parl(4)) iflqq =2103
14076 iflqq=1000*iflq+100*iflq+3
14081 IF(iflro.GT.0)
THEN
14082 CALL
lukfdi(iflqq,iflro,idum,k2)
14083 IF(k2.EQ.0) goto 10
14086 CALL
lukfdi(iflq,iflro,idum,k2)
14087 IF(k2.EQ.0) goto 10
14105 IF(kc2.GE.301.AND.kc2.LE.400)
z=1.-
z
14106 IF(lst(14).EQ.2)
THEN
14109 a=(amsp+amk2)/amsp - 2.
14110 z=
rlu(0)**(1./(
a+1.))
14111 ELSEIF(lst(14).EQ.3)
THEN
14116 IF(-4.*fc*
z*(1.-
z)**2.LT.
rlu(0)*((1.-
z)**2-fc*
z)**2) goto 30
14120 IF((k2a.GE.1.AND.k2a.LE.8).OR.k2a.EQ.21.OR.
lucomp(k2a).EQ.90)
14129 SUBROUTINE lscale(INFIN,QMAX)
14133 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
14134 COMMON /pypara/ ipy(80),pypar(80),pyvar(80)
14135 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
14136 four(i,j)=
p(i,4)*
p(j,4)-
p(i,1)*
p(j,1)-
p(i,2)*
p(j,2)-
p(i,3)*
p(j,3)
14139 IF(lst(8).GE.2.AND.lst(8).LE.5)
THEN
14141 IF(lst(9).EQ.1)
THEN
14143 ELSEIF(lst(9).EQ.2)
THEN
14145 ELSEIF(lst(9).EQ.3)
THEN
14147 ELSEIF(lst(9).EQ.4)
THEN
14149 ELSEIF(lst(9).EQ.5)
THEN
14150 qmax=q2*(1.-
x)*max(1.,
log(1./max(1.
e-06,
x)))
14151 ELSEIF(lst(9).EQ.9)
THEN
14154 WRITE(6,*)
' WARNING, LSCALE: LST(9)=',lst(9),
' NOT ALLOWED'
14156 ELSEIF(lst(8).GT.10.AND.lst(24).EQ.1.AND.lst(8).NE.19)
THEN
14160 ELSEIF(lst(8).GT.10.AND.lst(8).NE.19)
THEN
14164 IF(infin.LT.0) qmax=max(abs(-q2-2.*four(25,21)),
14165 & abs(-q2-2.*four(26,21)))
14167 IF(infin.LT.0)
THEN
14168 qmax=
sqrt(pypar(26)*qmax)
14170 qmax=
sqrt(pypar(25)*qmax)
14193 SUBROUTINE lshowr(ICALL)
14195 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
14196 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
14197 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
14198 COMMON /lboost/
dbeta(2,3),stheta(2),sphi(2),pb(5),phir
14201 COMMON /pypara/ ipy(80),pypar(80),pyvar(80)
14202 COMMON /pyproc/ isub,kfl(3,2),xpy(2),sh,th,uh,q2py,xsec(0:40)
14203 COMMON /pyint1/ xqpy(2,-6:6)
14208 common/foreficass/ievt
14213 DOUBLE PRECISION dtheta,dphi,
dbeta
14214 DOUBLE PRECISION dpq2,dpb(3),dpa(3),dcthet,drobo(5)
14215 dimension ks(9,5),ps(9,5),robo(5),xpq(-6:6)
14218 IF(icall.EQ.0)
THEN
14262 dpb(1)=0.5d0*(dpq2*(1d0/xr-1d0)+dble(ps(1,5))**2-
14263 +
ulmass(iabs(ks(7,2)))**2)/(ps(1,4)+ps(2,4))
14264 dpb(2)=dsqrt(dpb(1)**2+dpq2)
14265 dcthet=(dble(ps(2,4))*dpb(1)-dpq2/(2d0*xr))/(dble(ps(2,3))*
14267 dpa(1)=(dpb(2)*dcthet)**2-dpb(1)**2
14268 dpa(2)=dpq2-dble(pma1)**2+dble(pma2)**2
14269 ps(6,4)=-(dpa(2)*dpb(1)-dpb(2)*dcthet*dsqrt(dpa(2)**2+4d0*
14270 +dble(pma1)**2*dpa(1)))/(2d0*dpa(1))
14271 ps(6,3)=-
sqrt((ps(6,4)+pma1)*(ps(6,4)-pma1))
14286 50
p(
ns+1,j)=
p(3,j)
14291 dpa(3)=dsqrt(dpa(2)**2+4d0*dpq2*dble(pma1)**2)
14292 dpb(1)=(1d0/dble(xr)-2d0)*dpq2/(2d0*
sqrt(pw2))
14293 dpb(2)=dsqrt(dpb(1)**2+dpq2)
14294 p(
ns+3,4)=(dpb(2)*dpa(3)-dpb(1)*dpa(2))/(2d0*dpq2)
14320 k(
ns+5,4)=(
ns+3)*mstu(5)
14321 k(
ns+5,5)=(
ns+3)*mstu(5)
14341 CALL
pystfu(k(2,2),xr,q2,xpq)
14343 80 xqpy(2,ifl)=xpq(ifl)
14344 IF(lst(23).EQ.1)
THEN
14347 ELSEIF(lst(23).EQ.3)
THEN
14350 ELSEIF(lst(23).EQ.4)
THEN
14353 ELSEIF(lst(23).EQ.2)
THEN
14356 IF(isub.EQ.39.AND.ipy(11).EQ.1)
THEN
14358 ELSEIF(isub.EQ.39.AND.ipy(11).EQ.2)
THEN
14360 ELSEIF(isub.EQ.39.AND.ipy(11).EQ.3)
THEN
14362 ELSEIF(isub.EQ.40)
THEN
14370 IF(isub.EQ.39) kfl(3,1)=k(1,2)
14371 IF(isub.EQ.40) kfl(3,1)=k(1,2)+isign(1,k(1,2))
14373 pyvar(2)=(
p(1,4)+
p(2,4))**2
14374 pyvar(1)=
sqrt(pyvar(2))
14383 IF(ipy(13).EQ.1)
THEN
14385 qmax=min(qmax,
p(25,4))
14405 IF(xpy(2)*(1.+(
p(it,5)**2+pypar(22))/
p(21,5)**2).GT.0.999)
THEN
14406 WRITE(*,*)
'21-47 ERROR'
14410 IF (
ns.EQ.26)
WRITE(*,*)
'MAYBE BOZZO...',ievt+1
14411 IF(ipy(14).GE.1)
THEN
14412 WRITE(*,*)
'SPACE-LIKE SHOWER?',ievt+1
14424 100
p(
ns+1,j)=
p(21,j)
14432 p(
ns+3,3)=(
p(it,5)**2+q2)*(
p(21,4)-
p(21,3))/(2.*q2)
14440 k(23,4)=k(23,4)+(
ns+3)*mstu(5)
14441 k(23,5)=k(23,5)+(
ns+3)*mstu(5)
14457 IF(
p(
n+1,4).LE.1.01*
p(it,5))
THEN
14463 CALL ludbrb(25,
ns,0.,-robo(2),0.d0,0.d0,0.d0)
14464 CALL ludbrb(25,
ns,-robo(1),0.,0.d0,0.d0,0.d0)
14465 drobo(5)=-(
p(it,3)*
p(it,4)-
p(
n+1,4)*
sqrt(
p(
n+1,4)**2-
14466 +
p(it,4)**2+
p(it,3)**2))/(
p(it,3)**2+
p(
n+1,4)**2)
14467 CALL ludbrb(25,
ns,0.,0.,0.d0,0.d0,drobo(5))
14470 CALL ludbrb(25,
ns,robo(1),robo(2),0.d0,0.d0,0.d0)
14479 IF(ipy(48).EQ.1)
THEN
14489 CALL ludbrb(1,2,-stheta(2),0.,0.d0,0.d0,0.d0)
14491 CALL ludbrb(5,7,-stheta(2),0.,0.d0,0.d0,0.d0)
14502 IF(mstu(24).NE.0)
THEN
14504 IF(lst(3).GE.1)
WRITE(6,*)
' LUPREP ERROR MSTU(24)= ',mstu(24)
14517 120
p(
n+1,j)=
p(4,j)
14548 IF(k(
ns+1,2).EQ.k(3,2)) k(
ns+1,1)=0
14551 IF(k(i,1).LT.0)
THEN
14563 IF(
mod(lst(4)/10,10).EQ.0)
THEN
14587 SUBROUTINE lsigmx(NPAR,DERIV,DIFSIG,XF,IFLAG)
14596 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
14597 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
14598 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
14599 &q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
14600 COMMON /loptim/ optx(4),opty(4),optq2(4),optw2(4),comfac
14601 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
14602 dimension deriv(30),xf(30)
14603 common/linpatch/ncalls,ncall
14605 dummy=npar+deriv(1)
14606 IF(iflag.EQ.1) ncalls=0
14607 IF(iflag.EQ.2)
WRITE(6,10000)
14614 pm2=psave(3,2,5)**2
14615 IF(lst(31).EQ.1)
THEN
14618 w2=(1.-
x)*
y*parl(21)+psave(3,2,5)**2
14619 ELSEIF(lst(31).EQ.2)
THEN
14622 w2=(1.-
x)*
y*parl(21)+psave(3,2,5)**2
14623 ELSEIF(lst(31).EQ.3)
THEN
14625 y=(w2-psave(3,2,5)**2)/((1.-
x)*parl(21))
14628 q2low=max(q2min,
x*ymin*
s,(w2min-pm2)*
x/(1.-
x))
14629 q2upp=min(q2max,
x*ymax*
s,(w2max-pm2)*
x/(1.-
x))
14630 ylow=max(ymin,q2min/(
s*
x),(w2min-pm2)/(
s*(1.-
x)))
14631 yupp=min(ymax,q2max/(
s*
x),(w2max-pm2)/(
s*(1.-
x)))
14632 w2low=max(w2min,(1.-
x)*ymin*
s+pm2,q2min*(1.-
x)/
x+pm2)
14633 w2upp=min(w2max,(1.-
x)*ymax*
s+pm2,q2max*(1.-
x)/
x+pm2)
14634 IF(q2.LT.q2low.OR.q2.GT.q2upp)
RETURN
14635 IF(
y.LT.ylow.OR.
y.GT.yupp)
RETURN
14636 IF(w2.LT.w2low.OR.w2.GT.w2upp)
RETURN
14641 IF(lst(21).NE.0)
RETURN
14642 difsig=-pq(17)*comfac
14644 IF(lst(3).GE.4.AND.iflag.EQ.3)
WRITE(6,10100) ncalls,difsig,
x,
y,
14648 10000
FORMAT(
' WARNING: IFLAG = 2 IN CALL TO LSIGMX, WHICH DOES NOT '
14649 &,
'CALCULATE DERIVATIVES.')
14650 10100
FORMAT(/,5
x,
'TERMINATING ENTRY IN LSIGMX AFTER ',i5,
' CALLS.',/,
14651 &5
x,
'BEST ESTIMATE OF MINIMUM FOUND TO BE ',e12.4,/,
14652 &5
x,
'LOCATED AT X, Y, Q**2, W**2 = ',4g10.3,/)
14708 FUNCTION lunpik(ID,ISGN)
14709 COMMON / taukle / bra1,brk0,brk0b,brks
14710 REAL*4 bra1,brk0,brk0b,brks
14712 IF (
ident.EQ. 1)
THEN
14714 ELSEIF (
ident.EQ.-1)
THEN
14716 ELSEIF (
ident.EQ. 2)
THEN
14718 ELSEIF (
ident.EQ.-2)
THEN
14720 ELSEIF (
ident.EQ. 3)
THEN
14722 ELSEIF (
ident.EQ.-3)
THEN
14724 ELSEIF (
ident.EQ. 4)
THEN
14728 IF (xio.GT.brk0)
THEN
14733 ELSEIF (
ident.EQ.-4)
THEN
14737 IF (xio.GT.brk0b)
THEN
14742 ELSEIF (
ident.EQ. 8)
THEN
14744 ELSEIF (
ident.EQ.-8)
THEN
14746 ELSEIF (
ident.EQ. 9)
THEN
14748 ELSEIF (
ident.EQ.-9)
THEN
14751 print *,
'STOP IN IPKDEF, WRONG IDENT=',
ident
14762 SUBROUTINE lurobo(THE,PHI,BEX,BEY,BEZ)
14765 IMPLICIT DOUBLE PRECISION(
d)
14766 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
14767 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
14770 COMMON /polariz/pol(4000,3)
14773 SAVE /lujets/,/ludat1/
14774 dimension rot(3,3),pr(3),vr(3),dp(4),dv(4),por(3)
14778 IF(mstu(1).GT.0) imin=mstu(1)
14780 IF(mstu(2).GT.0) imax=mstu(2)
14787 entry ludbrb(imi,ima,the,
phi,dbex,dbey,dbez)
14789 IF(imin.LE.0) imin=1
14791 IF(imax.LE.0) imax=
n
14797 IF(mstu(33).NE.0)
THEN
14798 DO 20 i=min(imin,mstu(4)),min(imax,mstu(4))
14807 30
IF(imin.GT.mstu(4).OR.imax.GT.mstu(4))
THEN
14808 CALL
luerrm(11,
'(LUROBO:) RANGE OUTSIDE LUJETS MEMORY')
14813 IF(the**2+
phi**2.GT.1
e-20)
THEN
14824 IF(k(i,1).LE.0) goto 60
14831 pol(i,j)=rot(j,1)*por(1)+rot(j,2)*por(2)+rot(j,3)*por(3)
14832 p(i,j) =rot(j,1)*pr(1)+rot(j,2)*pr(2)+rot(j,3)*pr(3)
14833 v(i,j) =rot(j,1)*vr(1)+rot(j,2)*vr(2)+rot(j,3)*vr(3)
14843 IF(dbx**2+dby**2+dbz**2.GT.1
e-20)
THEN
14844 db=
sqrt(dbx**2+dby**2+dbz**2)
14845 IF(db.GT.0.99999999d0)
THEN
14847 CALL
luerrm(3,
'(LUROBO:) BOOST VECTOR TOO LARGE')
14848 dbx=dbx*(0.99999999d0/db)
14849 dby=dby*(0.99999999d0/db)
14850 dbz=dbz*(0.99999999d0/db)
14853 dga=1d0/
sqrt(1d0-db**2)
14855 IF(k(i,1).LE.0) goto 80
14860 dbp=dbx*dp(1)+dby*dp(2)+dbz*dp(3)
14861 dgabp=dga*(dga*dbp/(1d0+dga)+dp(4))
14862 p(i,1)=dp(1)+dgabp*dbx
14863 p(i,2)=dp(2)+dgabp*dby
14864 p(i,3)=dp(3)+dgabp*dbz
14865 p(i,4)=dga*(dp(4)+dbp)
14866 dbv=dbx*dv(1)+dby*dv(2)+dbz*dv(3)
14867 dgabv=dga*(dga*dbv/(1d0+dga)+dv(4))
14868 v(i,1)=dv(1)+dgabv*dbx
14869 v(i,2)=dv(2)+dgabv*dby
14870 v(i,3)=dv(3)+dgabv*dbz
14871 v(i,4)=dga*(dv(4)+dbv)
14885 IMPLICIT DOUBLE PRECISION(
d)
14886 parameter(maxpztry=1000, maxpztryr=10)
14887 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
14888 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
14889 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
14890 SAVE /lujets/,/ludat1/,/ludat2/
14891 dimension dps(5),kfl(3),pmq(3),
px(3),
py(3),gam(3),ie(2),pr(2),
14892 +
in(9),dhm(4),dhg(4),dp(5,5),irank(2),mju(4),iju(3),pju(5,5),
14893 +tju(5),kfjh(2),njs(2),kfjs(2),pjs(4,5),mstu9t(8),paru9t(8)
14896 four(i,j)=
p(i,4)*
p(j,4)-
p(i,1)*
p(j,1)-
p(i,2)*
p(j,2)-
p(i,3)*
p(j,3)
14897 dfour(i,j)=dp(i,4)*dp(j,4)-dp(i,1)*dp(j,1)-dp(i,2)*dp(j,2)-
14913 IF(i.GT.min(
n,mstu(4)-mstu(32)))
THEN
14914 CALL
luerrm(12,
'(LUSTRF:) failed to reconstruct jet system')
14915 IF(mstu(21).GE.1)
RETURN
14917 IF(k(i,1).NE.1.AND.k(i,1).NE.2.AND.k(i,1).NE.41) goto 110
14919 IF(kc.EQ.0) goto 110
14920 kq=kchg(kc,2)*isign(1,k(i,2))
14921 IF(kq.EQ.0) goto 110
14922 IF(
n+5*np+11.GT.mstu(4)-mstu(32)-5)
THEN
14923 CALL
luerrm(11,
'(LUSTRF:) no more memory left in LUJETS')
14924 IF(mstu(21).GE.1)
RETURN
14932 IF(j.NE.4) dps(j)=dps(j)+
p(i,j)
14934 dps(4)=dps(4)+
sqrt(dble(
p(i,1))**2+dble(
p(i,2))**2+
14935 +dble(
p(i,3))**2+dble(
p(i,5))**2)
14937 IF(kq.NE.2) kqsum=kqsum+kq
14938 IF(k(i,1).EQ.41)
THEN
14940 IF(kqsum.EQ.kq) mju(1)=
n+np
14941 IF(kqsum.NE.kq) mju(2)=
n+np
14943 IF(k(i,1).EQ.2.OR.k(i,1).EQ.41) goto 110
14944 IF(kqsum.NE.0)
THEN
14945 CALL
luerrm(12,
'(LUSTRF:) unphysical flavour combination')
14946 IF(mstu(21).GE.1)
RETURN
14950 IF(abs(dps(3)).LT.0.99d0*dps(4))
THEN
14953 CALL ludbrb(
n+1,
n+np,0.,0.,-dps(1)/dps(4),-dps(2)/dps(4),
14957 hhbz=
sqrt(max(1
d-6,dps(4)+dps(3))/max(1
d-6,dps(4)-dps(3)))
14959 hhpmt=
p(i,1)**2+
p(i,2)**2+
p(i,5)**2
14960 IF(
p(i,3).GT.0.)
THEN
14961 hhpez=(
p(i,4)+
p(i,3))/hhbz
14962 p(i,3)=0.5*(hhpez-hhpmt/hhpez)
14963 p(i,4)=0.5*(hhpez+hhpmt/hhpez)
14965 hhpez=(
p(i,4)-
p(i,3))*hhbz
14966 p(i,3)=-0.5*(hhpez-hhpmt/hhpez)
14967 p(i,4)=0.5*(hhpez+hhpmt/hhpez)
14979 140
IF(nr.GE.3)
THEN
14982 IF(i.EQ.
n+nr.AND.iabs(k(
n+1,2)).NE.21) goto 150
14984 IF(i.EQ.
n+nr) i1=
n+1
14985 IF(k(i,1).EQ.41.OR.k(i1,1).EQ.41) goto 150
14986 IF(mju(1).NE.0.AND.i1.LT.mju(1).AND.iabs(k(i1,2)).NE.21)
14988 IF(mju(2).NE.0.AND.i.GT.mju(2).AND.iabs(k(i,2)).NE.21) goto
14990 pap=
sqrt((
p(i,1)**2+
p(i,2)**2+
p(i,3)**2)*(
p(i1,1)**2+
p(i1,2)
14992 pvp=
p(i,1)*
p(i1,1)+
p(i,2)*
p(i1,2)+
p(i,3)*
p(i1,3)
14993 pdr=4.*(pap-pvp)**2/max(1
e-6,paru13**2*pap+2.*(pap-pvp))
14994 IF(pdr.LT.pdrmin)
THEN
15001 IF(pdrmin.LT.paru12.AND.ir.EQ.
n+nr)
THEN
15003 p(
n+1,j)=
p(
n+1,j)+
p(
n+nr,j)
15005 p(
n+1,5)=
sqrt(max(0.,
p(
n+1,4)**2-
p(
n+1,1)**2-
p(
n+1,2)**2-
15009 ELSEIF(pdrmin.LT.paru12)
THEN
15011 p(ir,j)=
p(ir,j)+
p(ir+1,j)
15013 p(ir,5)=
sqrt(max(0.,
p(ir,4)**2-
p(ir,1)**2-
p(ir,2)**2-
15015 DO 190 i=ir+1,
n+nr-1
15021 IF(ir.EQ.
n+nr-1) k(ir,2)=k(
n+nr,2)
15023 IF(mju(1).GT.ir) mju(1)=mju(1)-1
15024 IF(mju(2).GT.ir) mju(2)=mju(2)-1
15032 nrs=max(5*nr+11,np)
15035 IF(ntry.GT.maxpztry.AND.ntryr.LE.maxpztryr)
THEN
15039 ELSEIF(ntry.GT.maxpztry)
THEN
15040 CALL
luerrm(14,
'(LUSTRF:) caught in infinite loop')
15041 IF(mstu(21).GE.1)
RETURN
15045 IF(mju(1).EQ.0.AND.mju(2).EQ.0) goto 580
15048 IF(mju(jt).EQ.0) goto 570
15059 DO 240 i1=
n+1+(jt-1)*(nr-1),
n+nr+(jt-1)*(1-nr),js
15060 IF(k(i1,2).NE.21.AND.iu.LE.2)
THEN
15065 pju(iu,j)=pju(iu,j)+
p(i1,j)
15069 pju(iu,5)=
sqrt(pju(iu,1)**2+pju(iu,2)**2+pju(iu,3)**2)
15071 IF(k(iju(3),2)/100.NE.10*k(iju(1),2)+k(iju(2),2).AND. k(iju(3),
15072 + 2)/100.NE.10*k(iju(2),2)+k(iju(1),2))
THEN
15073 CALL
luerrm(12,
'(LUSTRF:) unphysical flavour combination')
15074 IF(mstu(21).GE.1)
RETURN
15078 t12=(pju(1,1)*pju(2,1)+pju(1,2)*pju(2,2)+pju(1,3)*pju(2,3))/
15079 + (pju(1,5)*pju(2,5))
15080 t13=(pju(1,1)*pju(3,1)+pju(1,2)*pju(3,2)+pju(1,3)*pju(3,3))/
15081 + (pju(1,5)*pju(3,5))
15082 t23=(pju(2,1)*pju(3,1)+pju(2,2)*pju(3,2)+pju(2,3)*pju(3,3))/
15083 + (pju(2,5)*pju(3,5))
15084 t11=
sqrt((2./3.)*(1.-t12)*(1.-t13)/(1.-t23))
15085 t22=
sqrt((2./3.)*(1.-t12)*(1.-t23)/(1.-t13))
15086 tsq=
sqrt((2.*t11*t22+t12-1.)*(1.+t12))
15087 t1f=(tsq-t22*(1.+t12))/(1.-t12**2)
15088 t2f=(tsq-t11*(1.+t12))/(1.-t12**2)
15090 tju(j)=-(t1f*pju(1,j)/pju(1,5)+t2f*pju(2,j)/pju(2,5))
15092 tju(4)=
sqrt(1.+tju(1)**2+tju(2)**2+tju(3)**2)
15094 pju(iu,5)=tju(4)*pju(iu,4)-tju(1)*pju(iu,1)-tju(2)*pju(iu,2)-
15099 IF(pju(1,5)+pju(2,5).GT.pju(1,4)+pju(2,4))
THEN
15112 ns=iju(iu+1)-iju(iu)
15119 dp(1,j)=0.5*
p(is1,j)
15120 IF(is.EQ.1) dp(1,j)=
p(is1,j)
15121 dp(2,j)=0.5*
p(is2,j)
15122 IF(is.EQ.
ns) dp(2,j)=-pju(iu,j)
15124 IF(is.EQ.
ns) dp(2,4)=
sqrt(pju(iu,1)**2+pju(iu,2)**2+pju(iu,
15126 IF(is.EQ.
ns) dp(2,5)=0.
15130 IF(dp(3,5)+2.*dhkc+dp(4,5).LE.0.)
THEN
15131 dp(1,4)=
sqrt(dp(1,1)**2+dp(1,2)**2+dp(1,3)**2)
15132 dp(2,4)=
sqrt(dp(2,1)**2+dp(2,2)**2+dp(2,3)**2)
15137 dhks=
sqrt(dhkc**2-dp(3,5)*dp(4,5))
15138 dhk1=0.5*((dp(4,5)+dhkc)/dhks-1.)
15139 dhk2=0.5*((dp(3,5)+dhkc)/dhks-1.)
15141 p(in1,5)=
sqrt(dp(3,5)+2.*dhkc+dp(4,5))
15143 p(in1,j)=(1.+dhk1)*dp(1,j)-dhk2*dp(2,j)
15144 p(in1+1,j)=(1.+dhk2)*dp(2,j)-dhk1*dp(1,j)
15152 IF(ntry.GT.maxpztry.AND.ntryr.LE.maxpztryr)
THEN
15156 ELSEIF(ntry.GT.maxpztry)
THEN
15157 CALL
luerrm(14,
'(LUSTRF:) caught in infinite loop')
15158 IF(mstu(21).GE.1)
RETURN
15163 ie(1)=k(
n+1+(jt/2)*(np-1),3)
15168 DO 330 in1=
n+nr+2+jq,
n+nr+4*
ns-2+jq,4
15174 kfl(1)=k(iju(iu),2)
15185 dp(2,j)=
p(
in(4)+1,j)
15189 dp(1,4)=
sqrt(dp(1,1)**2+dp(1,2)**2+dp(1,3)**2)
15190 dp(2,4)=
sqrt(dp(2,1)**2+dp(2,2)**2+dp(2,3)**2)
15191 dp(5,1)=dp(1,1)/dp(1,4)-dp(2,1)/dp(2,4)
15192 dp(5,2)=dp(1,2)/dp(1,4)-dp(2,2)/dp(2,4)
15193 dp(5,3)=dp(1,3)/dp(1,4)-dp(2,3)/dp(2,4)
15194 IF(dp(5,1)**2.LE.dp(5,2)**2+dp(5,3)**2) dp(3,1)=1.
15195 IF(dp(5,1)**2.GT.dp(5,2)**2+dp(5,3)**2) dp(3,3)=1.
15196 IF(dp(5,2)**2.LE.dp(5,1)**2+dp(5,3)**2) dp(4,2)=1.
15197 IF(dp(5,2)**2.GT.dp(5,1)**2+dp(5,3)**2) dp(4,3)=1.
15199 dhcx1=dfour(3,1)/dhc12
15200 dhcx2=dfour(3,2)/dhc12
15201 dhcxx=1d0/
sqrt(1d0+2d0*dhcx1*dhcx2*dhc12)
15202 dhcy1=dfour(4,1)/dhc12
15203 dhcy2=dfour(4,2)/dhc12
15204 dhcyx=dhcxx*(dhcx1*dhcy2+dhcx2*dhcy1)*dhc12
15205 dhcyy=1d0/
sqrt(1d0+2d0*dhcy1*dhcy2*dhc12-dhcyx**2)
15207 dp(3,j)=dhcxx*(dp(3,j)-dhcx2*dp(1,j)-dhcx1*dp(2,j))
15209 p(
in(6)+1,j)=dhcyy*(dp(4,j)-dhcy2*dp(1,j)-dhcy1*dp(2,j)-
15215 IF(2*i-nsav.GE.mstu(4)-mstu(32)-5)
THEN
15216 CALL
luerrm(11,
'(LUSTRF:) no more memory left in LUJETS')
15217 IF(mstu(21).GE.1)
RETURN
15226 390 CALL
lukfdi(kfl(1),0,kfl(3),k(i,2))
15227 IF(k(i,2).EQ.0) goto 320
15228 IF(mstj(12).GE.3.AND.irankj.EQ.1.AND.iabs(kfl(1)).LE.10.AND.
15229 + iabs(kfl(3)).GT.10)
THEN
15230 IF(
rlu(0).GT.parj(19)) goto 390
15234 pr(1)=
p(i,5)**2+(
px(1)+
px(3))**2+(
py(1)+
py(3))**2
15235 CALL
luzdis(kfl(1),kfl(3),pr(1),
z)
15236 IF(iabs(kfl(1)).GE.4.AND.iabs(kfl(1)).LE.8.AND. mstu(90)
15238 mstu(90)=mstu(90)+1
15239 mstu(90+mstu(90))=i
15240 paru(90+mstu(90))=
z
15242 gam(3)=(1.-
z)*(gam(1)+pr(1)/
z)
15249 + 5)**2.GE.pr(1))
THEN
15251 p(
in(2)+2,4)=pr(1)/(
p(
in(1)+2,4)*
p(
in(1),5)**2)
15257 ELSEIF(
in(1)+1.EQ.
in(2))
THEN
15258 p(
in(2)+2,4)=
p(
in(2)+2,3)
15261 IF(
in(2).GT.
n+nr+4*
ns) goto 320
15262 IF(four(
in(1),
in(2)).LE.1
e-2)
THEN
15263 p(
in(1)+2,4)=
p(
in(1)+2,3)
15270 420
IF(
in(1).GT.
n+nr+4*
ns.OR.
in(2).GT.
n+nr+4*
ns.OR.
in(1)
15271 + .GT.
in(2)) goto 320
15272 IF(
in(1).NE.
in(4).OR.
in(2).NE.
in(5))
THEN
15279 dp(1,4)=
sqrt(dp(1,1)**2+dp(1,2)**2+dp(1,3)**2)
15280 dp(2,4)=
sqrt(dp(2,1)**2+dp(2,2)**2+dp(2,3)**2)
15282 IF(dhc12.LE.1
e-2)
THEN
15283 p(
in(1)+2,4)=
p(
in(1)+2,3)
15289 dp(5,1)=dp(1,1)/dp(1,4)-dp(2,1)/dp(2,4)
15290 dp(5,2)=dp(1,2)/dp(1,4)-dp(2,2)/dp(2,4)
15291 dp(5,3)=dp(1,3)/dp(1,4)-dp(2,3)/dp(2,4)
15292 IF(dp(5,1)**2.LE.dp(5,2)**2+dp(5,3)**2) dp(3,1)=1.
15293 IF(dp(5,1)**2.GT.dp(5,2)**2+dp(5,3)**2) dp(3,3)=1.
15294 IF(dp(5,2)**2.LE.dp(5,1)**2+dp(5,3)**2) dp(4,2)=1.
15295 IF(dp(5,2)**2.GT.dp(5,1)**2+dp(5,3)**2) dp(4,3)=1.
15296 dhcx1=dfour(3,1)/dhc12
15297 dhcx2=dfour(3,2)/dhc12
15298 dhcxx=1d0/
sqrt(1d0+2d0*dhcx1*dhcx2*dhc12)
15299 dhcy1=dfour(4,1)/dhc12
15300 dhcy2=dfour(4,2)/dhc12
15301 dhcyx=dhcxx*(dhcx1*dhcy2+dhcx2*dhcy1)*dhc12
15302 dhcyy=1d0/
sqrt(1d0+2d0*dhcy1*dhcy2*dhc12-dhcyx**2)
15304 dp(3,j)=dhcxx*(dp(3,j)-dhcx2*dp(1,j)-dhcx1*dp(2,j))
15306 p(
in(3)+1,j)=dhcyy*(dp(4,j)-dhcy2*dp(1,j)-dhcy1*dp(2,j)-
15310 pxp=-(
px(3)*four(
in(6),
in(3))+
py(3)*four(
in(6)+1,
in(3)))
15313 IF(abs(pxp**2+
pyp**2-
px(3)**2-
py(3)**2).LT.0.01)
THEN
15323 + +
py(3)*
p(
in(3)+1,j)
15324 DO 450 in1=
in(4),
in(1)-4,4
15325 p(i,j)=
p(i,j)+
p(in1+2,3)*
p(in1,j)
15327 DO 460 in2=
in(5),
in(2)-4,4
15328 p(i,j)=
p(i,j)+
p(in2+2,3)*
p(in2,j)
15332 dhm(2)=2.*four(i,
in(1))
15333 dhm(3)=2.*four(i,
in(2))
15334 dhm(4)=2.*four(
in(1),
in(2))
15337 DO 490 in2=
in(1)+1,
in(2),4
15338 DO 480 in1=
in(1),in2-1,4
15339 dhc=2.*four(in1,in2)
15340 dhg(1)=dhg(1)+
p(in1+2,1)*
p(in2+2,1)*dhc
15341 IF(in1.EQ.
in(1)) dhg(2)=dhg(2)-
p(in2+2,1)*dhc
15342 IF(in2.EQ.
in(2)) dhg(3)=dhg(3)+
p(in1+2,1)*dhc
15343 IF(in1.EQ.
in(1).AND.in2.EQ.
in(2)) dhg(4)=dhg(4)-dhc
15348 dhs1=dhm(3)*dhg(4)-dhm(4)*dhg(3)
15349 IF(abs(dhs1).LT.1
e-4) goto 320
15350 dhs2=dhm(4)*(gam(3)-dhg(1))-dhm(2)*dhg(3)-dhg(4)* (
p(i,5)**2-
15351 + dhm(1))+dhg(2)*dhm(3)
15352 dhs3=dhm(2)*(gam(3)-dhg(1))-dhg(2)*(
p(i,5)**2-dhm(1))
15353 p(
in(2)+2,4)=0.5*(
sqrt(max(0d0,dhs2**2-4.*dhs1*dhs3))/
15354 + abs(dhs1)- dhs2/dhs1)
15355 IF(dhm(2)+dhm(4)*
p(
in(2)+2,4).LE.0.) goto 320
15356 p(
in(1)+2,4)=(
p(i,5)**2-dhm(1)-dhm(3)*
p(
in(2)+2,4))/ (dhm(2)+
15357 + dhm(4)*
p(
in(2)+2,4))
15360 IF(
p(
in(2)+2,4).GT.
p(
in(2)+2,3))
THEN
15361 p(
in(2)+2,4)=
p(
in(2)+2,3)
15364 IF(
in(2).GT.
n+nr+4*
ns) goto 320
15365 IF(four(
in(1),
in(2)).LE.1
e-2)
THEN
15366 p(
in(1)+2,4)=
p(
in(1)+2,3)
15371 ELSEIF(
p(
in(1)+2,4).GT.
p(
in(1)+2,3))
THEN
15372 p(
in(1)+2,4)=
p(
in(1)+2,3)
15382 pju(iu+3,j)=pju(iu+3,j)+
p(i,j)
15384 IF(
p(i,4).LT.
p(i,5)) goto 320
15385 pju(iu+3,5)=tju(4)*pju(iu+3,4)-tju(1)*pju(iu+3,1)- tju(2)*
15386 + pju(iu+3,2)-tju(3)*pju(iu+3,3)
15387 IF(pju(iu+3,5).LT.pju(iu,5))
THEN
15392 IF(
in(3).NE.
in(6))
THEN
15395 p(
in(6)+1,j)=
p(
in(3)+1,j)
15400 p(
in(jq)+2,3)=
p(
in(jq)+2,3)-
p(
in(jq)+2,4)
15401 p(
in(jq)+2,1)=
p(
in(jq)+2,1)-(3-2*jq)*
p(
in(jq)+2,4)
15407 IF(iabs(kfl(1)).GT.10) goto 320
15411 pju(iu+3,j)=pju(iu+3,j)-
p(i+1,j)
15417 kfjs(jt)=k(k(mju(jt+2),3),2)
15418 kfls=2*
int(
rlu(0)+3.*parj(4)/(1.+3.*parj(4)))+1
15419 IF(kfjh(1).EQ.kfjh(2)) kfls=3
15420 IF(ista.NE.i) kfjs(jt)=isign(1000*max(iabs(kfjh(1)), iabs(kfjh(
15421 + 2)))+100*min(iabs(kfjh(1)),iabs(kfjh(2)))+ kfls,kfjh(1))
15423 pjs(jt,j)=pju(1,j)+pju(2,j)+
p(mju(jt),j)
15424 pjs(jt+2,j)=pju(4,j)+pju(5,j)
15426 pjs(jt,5)=
sqrt(max(0.,pjs(jt,4)**2-pjs(jt,1)**2-pjs(jt,2)**2-
15431 580
IF(mju(1).NE.0.AND.mju(2).NE.0)
THEN
15434 ELSEIF(mju(1).NE.0)
THEN
15437 ELSEIF(mju(2).NE.0)
THEN
15440 ELSEIF(iabs(k(
n+1,2)).NE.21)
THEN
15447 p(
n+nr+is,1)=0.5*four(
n+is,
n+is+1-nr*(is/nr))
15448 w2sum=w2sum+
p(
n+nr+is,1)
15453 w2sum=w2sum-
p(
n+nr+nb,1)
15454 IF(w2sum.GT.w2ran.AND.nb.LT.nr) goto 600
15459 is1=
n+is+nb-1-nr*((is+nb-2)/nr)
15460 is2=
n+is+nb-nr*((is+nb-1)/nr)
15463 IF(iabs(k(is1,2)).EQ.21) dp(1,j)=0.5*dp(1,j)
15464 IF(is1.EQ.mju(1)) dp(1,j)=pjs(1,j)-pjs(3,j)
15466 IF(iabs(k(is2,2)).EQ.21) dp(2,j)=0.5*dp(2,j)
15467 IF(is2.EQ.mju(2)) dp(2,j)=pjs(2,j)-pjs(4,j)
15472 IF(dp(3,5)+2.*dhkc+dp(4,5).LE.0.)
THEN
15475 dp(1,4)=
sqrt(dp(1,1)**2+dp(1,2)**2+dp(1,3)**2+dp(1,5)**2)
15476 dp(2,4)=
sqrt(dp(2,1)**2+dp(2,2)**2+dp(2,3)**2+dp(2,5)**2)
15479 dhks=
sqrt(dhkc**2-dp(3,5)*dp(4,5))
15480 dhk1=0.5*((dp(4,5)+dhkc)/dhks-1.)
15481 dhk2=0.5*((dp(3,5)+dhkc)/dhks-1.)
15483 p(in1,5)=
sqrt(dp(3,5)+2.*dhkc+dp(4,5))
15485 p(in1,j)=(1.+dhk1)*dp(1,j)-dhk2*dp(2,j)
15486 p(in1+1,j)=(1.+dhk2)*dp(2,j)-dhk1*dp(1,j)
15494 IF(ntry.GT.maxpztry.AND.ntryr.LE.maxpztryr)
THEN
15498 ELSEIF(ntry.GT.maxpztry)
THEN
15499 CALL
luerrm(14,
'(LUSTRF:) caught in infinite loop')
15500 IF(mstu(21).GE.1)
RETURN
15507 p(
n+nrs,j)=
p(
n+nrs,j)+
p(
n+is,j)
15512 IF(mju(jt).NE.0) irank(jt)=njs(jt)
15513 IF(
ns.GT.nr) irank(jt)=1
15514 ie(jt)=k(
n+1+(jt/2)*(np-1),3)
15515 in(3*jt+1)=
n+nr+1+4*(jt/2)*(
ns-1)
15516 in(3*jt+2)=
in(3*jt+1)+1
15517 in(3*jt+3)=
n+nr+4*
ns+2*jt-1
15518 DO 670 in1=
n+nr+2+jt,
n+nr+4*
ns-2+jt,4
15529 IF(
ns.EQ.1.AND.mju(1)+mju(2).EQ.0) CALL
luptdi(0,
px(1),
py(1))
15533 kfl(jt)=k(ie(jt),2)
15534 IF(mju(jt).NE.0) kfl(jt)=kfjs(jt)
15542 kfl(3)=
int(1.+(2.+parj(2))*
rlu(0))*(-1)**
int(
rlu(0)+0.5)
15543 CALL
lukfdi(kfl(3),0,kfl(1),kdump)
15545 IF(iabs(kfl(1)).GT.10.AND.
rlu(0).GT.0.5)
THEN
15546 kfl(2)=-(kfl(1)+isign(10000,kfl(1)))
15547 ELSEIF(iabs(kfl(1)).GT.10)
THEN
15548 kfl(1)=-(kfl(2)+isign(10000,kfl(2)))
15553 pr3=min(25.,0.1*
p(
n+nr+1,5)**2)
15554 700 CALL
luzdis(kfl(1),kfl(2),pr3,
z)
15555 zr=pr3/(
z*
p(
n+nr+1,5)**2)
15556 IF(zr.GE.1.) goto 700
15560 gam(jt)=pr3*(1.-
z)/
z
15561 in1=
n+nr+3+4*(jt/2)*(
ns-1)
15564 p(in1,3)=(2-jt)*(1.-
z)+(jt-1)*
z
15567 p(in1+1,3)=(2-jt)*(1.-zr)+(jt-1)*zr
15573 IF(jt.EQ.1.OR.
ns.EQ.nr-1)
THEN
15582 dp(1,4)=
sqrt(dp(1,1)**2+dp(1,2)**2+dp(1,3)**2)
15583 dp(2,4)=
sqrt(dp(2,1)**2+dp(2,2)**2+dp(2,3)**2)
15584 dp(5,1)=dp(1,1)/dp(1,4)-dp(2,1)/dp(2,4)
15585 dp(5,2)=dp(1,2)/dp(1,4)-dp(2,2)/dp(2,4)
15586 dp(5,3)=dp(1,3)/dp(1,4)-dp(2,3)/dp(2,4)
15587 IF(dp(5,1)**2.LE.dp(5,2)**2+dp(5,3)**2) dp(3,1)=1.
15588 IF(dp(5,1)**2.GT.dp(5,2)**2+dp(5,3)**2) dp(3,3)=1.
15589 IF(dp(5,2)**2.LE.dp(5,1)**2+dp(5,3)**2) dp(4,2)=1.
15590 IF(dp(5,2)**2.GT.dp(5,1)**2+dp(5,3)**2) dp(4,3)=1.
15592 dhcx1=dfour(3,1)/dhc12
15593 dhcx2=dfour(3,2)/dhc12
15594 dhcxx=1d0/
sqrt(1d0+2d0*dhcx1*dhcx2*dhc12)
15595 dhcy1=dfour(4,1)/dhc12
15596 dhcy2=dfour(4,2)/dhc12
15597 dhcyx=dhcxx*(dhcx1*dhcy2+dhcx2*dhcy1)*dhc12
15598 dhcyy=1d0/
sqrt(1d0+2d0*dhcy1*dhcy2*dhc12-dhcyx**2)
15600 dp(3,j)=dhcxx*(dp(3,j)-dhcx2*dp(1,j)-dhcx1*dp(2,j))
15602 p(in3+1,j)=dhcyy*(dp(4,j)-dhcy2*dp(1,j)-dhcy1*dp(2,j)-
15607 p(in3+2,j)=
p(in3,j)
15608 p(in3+3,j)=
p(in3+1,j)
15614 IF(mju(1)+mju(2).GT.0)
THEN
15616 IF(njs(jt).EQ.0) goto 770
15618 p(
n+nrs,j)=
p(
n+nrs,j)-pjs(jt+2,j)
15625 IF(2*i-nsav.GE.mstu(4)-mstu(32)-5)
THEN
15626 CALL
luerrm(11,
'(LUSTRF:) no more memory left in LUJETS')
15627 IF(mstu(21).GE.1)
RETURN
15630 IF(iabs(kfl(3-jt)).GT.10) jt=3-jt
15631 IF(iabs(kfl(3-jt)).GE.4.AND.iabs(kfl(3-jt)).LE.8) jt=3-jt
15634 irank(jt)=irank(jt)+1
15641 790 CALL
lukfdi(kfl(jt),0,kfl(3),k(i,2))
15642 IF(k(i,2).EQ.0) goto 640
15643 IF(mstj(12).GE.3.AND.irank(jt).EQ.1.AND.iabs(kfl(jt)).LE.10.AND.
15644 +iabs(kfl(3)).GT.10)
THEN
15645 IF(
rlu(0).GT.parj(19)) goto 790
15649 pr(jt)=
p(i,5)**2+(
px(jt)+
px(3))**2+(
py(jt)+
py(3))**2
15655 IF(mstj(11).EQ.2) parjst=parj(34)
15656 wmin=parjst+pmq(1)+pmq(2)+parj(36)*pmq(3)
15657 IF(iabs(kfl(jt)).GT.10.AND.iabs(kfl(3)).GT.10) wmin=
15658 +wmin-0.5*parj(36)*pmq(3)
15659 wrem2=four(
n+nrs,
n+nrs)
15660 IF(wrem2.LT.0.10) goto 640
15661 IF(wrem2.LT.max(wmin*(1.+(2.*
rlu(0)-1.)*parj(37)),
15662 +parj(32)+pmq(1)+pmq(2))**2) goto 940
15665 CALL
luzdis(kfl(jt),kfl(3),pr(jt),
z)
15666 IF(iabs(kfl(jt)).GE.4.AND.iabs(kfl(jt)).LE.8.AND.
15667 +mstu(90).LT.8)
THEN
15668 mstu(90)=mstu(90)+1
15669 mstu(90+mstu(90))=i
15670 paru(90+mstu(90))=
z
15674 IF(max(
mod(kfl1a,10),
mod(kfl1a/1000,10),
mod(kfl2a,10),
15675 +
mod(kfl2a/1000,10)).GE.4)
THEN
15676 pr(jr)=(pmq(jr)+pmq(3))**2+(
px(jr)-
px(3))**2+(
py(jr)-
py(3))**2
15677 pw12=
sqrt(max(0.,(wrem2-pr(1)-pr(2))**2-4.*pr(1)*pr(2)))
15678 z=(wrem2+pr(jt)-pr(jr)+pw12*(2.*
z-1.))/(2.*wrem2)
15679 pr(jr)=(pmq(jr)+parjst)**2+(
px(jr)-
px(3))**2+(
py(jr)-
py(3))**2
15680 IF((1.-
z)*(wrem2-pr(jt)/
z).LT.pr(jr)) goto 940
15682 gam(3)=(1.-
z)*(gam(jt)+pr(jt)/
z)
15688 IF(
in(1)+1.EQ.
in(2).AND.
z*
p(
in(1)+2,3)*
p(
in(2)+2,3)*
15689 +
p(
in(1),5)**2.GE.pr(jt))
THEN
15690 p(
in(jt)+2,4)=
z*
p(
in(jt)+2,3)
15691 p(
in(jr)+2,4)=pr(jt)/(
p(
in(jt)+2,4)*
p(
in(1),5)**2)
15696 ELSEIF(
in(1)+1.EQ.
in(2))
THEN
15697 p(
in(jr)+2,4)=
p(
in(jr)+2,3)
15700 IF(js*
in(jr).GT.js*
in(4*jr)) goto 640
15701 IF(four(
in(1),
in(2)).LE.1
e-2)
THEN
15702 p(
in(jt)+2,4)=
p(
in(jt)+2,3)
15709 820
IF(js*
in(1).GT.js*
in(3*jr+1).OR.js*
in(2).GT.js*
in(3*jr+2).OR.
15710 +
in(1).GT.
in(2)) goto 640
15711 IF(
in(1).NE.
in(3*jt+1).OR.
in(2).NE.
in(3*jt+2))
THEN
15718 dp(1,4)=
sqrt(dp(1,1)**2+dp(1,2)**2+dp(1,3)**2)
15719 dp(2,4)=
sqrt(dp(2,1)**2+dp(2,2)**2+dp(2,3)**2)
15721 IF(dhc12.LE.1
e-2)
THEN
15722 p(
in(jt)+2,4)=
p(
in(jt)+2,3)
15728 dp(5,1)=dp(1,1)/dp(1,4)-dp(2,1)/dp(2,4)
15729 dp(5,2)=dp(1,2)/dp(1,4)-dp(2,2)/dp(2,4)
15730 dp(5,3)=dp(1,3)/dp(1,4)-dp(2,3)/dp(2,4)
15731 IF(dp(5,1)**2.LE.dp(5,2)**2+dp(5,3)**2) dp(3,1)=1.
15732 IF(dp(5,1)**2.GT.dp(5,2)**2+dp(5,3)**2) dp(3,3)=1.
15733 IF(dp(5,2)**2.LE.dp(5,1)**2+dp(5,3)**2) dp(4,2)=1.
15734 IF(dp(5,2)**2.GT.dp(5,1)**2+dp(5,3)**2) dp(4,3)=1.
15735 dhcx1=dfour(3,1)/dhc12
15736 dhcx2=dfour(3,2)/dhc12
15737 dhcxx=1d0/
sqrt(1d0+2d0*dhcx1*dhcx2*dhc12)
15738 dhcy1=dfour(4,1)/dhc12
15739 dhcy2=dfour(4,2)/dhc12
15740 dhcyx=dhcxx*(dhcx1*dhcy2+dhcx2*dhcy1)*dhc12
15741 dhcyy=1d0/
sqrt(1d0+2d0*dhcy1*dhcy2*dhc12-dhcyx**2)
15743 dp(3,j)=dhcxx*(dp(3,j)-dhcx2*dp(1,j)-dhcx1*dp(2,j))
15745 p(
in(3)+1,j)=dhcyy*(dp(4,j)-dhcy2*dp(1,j)-dhcy1*dp(2,j)-
15749 pxp=-(
px(3)*four(
in(3*jt+3),
in(3))+
py(3)*
15750 + four(
in(3*jt+3)+1,
in(3)))
15752 + four(
in(3*jt+3)+1,
in(3)+1))
15753 IF(abs(pxp**2+
pyp**2-
px(3)**2-
py(3)**2).LT.0.01)
THEN
15762 p(i,j)=
px(jt)*
p(
in(3*jt+3),j)+
py(jt)*
p(
in(3*jt+3)+1,j)+
px(3)*
15764 DO 850 in1=
in(3*jt+1),
in(1)-4*js,4*js
15765 p(i,j)=
p(i,j)+
p(in1+2,3)*
p(in1,j)
15767 DO 860 in2=
in(3*jt+2),
in(2)-4*js,4*js
15768 p(i,j)=
p(i,j)+
p(in2+2,3)*
p(in2,j)
15772 dhm(2)=2.*four(i,
in(1))
15773 dhm(3)=2.*four(i,
in(2))
15774 dhm(4)=2.*four(
in(1),
in(2))
15777 DO 890 in2=
in(1)+1,
in(2),4
15778 DO 880 in1=
in(1),in2-1,4
15779 dhc=2.*four(in1,in2)
15780 dhg(1)=dhg(1)+
p(in1+2,jt)*
p(in2+2,jt)*dhc
15781 IF(in1.EQ.
in(1)) dhg(2)=dhg(2)-js*
p(in2+2,jt)*dhc
15782 IF(in2.EQ.
in(2)) dhg(3)=dhg(3)+js*
p(in1+2,jt)*dhc
15783 IF(in1.EQ.
in(1).AND.in2.EQ.
in(2)) dhg(4)=dhg(4)-dhc
15788 dhs1=dhm(jr+1)*dhg(4)-dhm(4)*dhg(jr+1)
15789 IF(abs(dhs1).LT.1
e-4) goto 640
15790 dhs2=dhm(4)*(gam(3)-dhg(1))-dhm(jt+1)*dhg(jr+1)-dhg(4)*
15791 +(
p(i,5)**2-dhm(1))+dhg(jt+1)*dhm(jr+1)
15792 dhs3=dhm(jt+1)*(gam(3)-dhg(1))-dhg(jt+1)*(
p(i,5)**2-dhm(1))
15793 p(
in(jr)+2,4)=0.5*(
sqrt(max(0d0,dhs2**2-4.*dhs1*dhs3))/abs(dhs1)-
15795 IF(dhm(jt+1)+dhm(4)*
p(
in(jr)+2,4).LE.0.) goto 640
15796 p(
in(jt)+2,4)=(
p(i,5)**2-dhm(1)-dhm(jr+1)*
p(
in(jr)+2,4))/
15797 +(dhm(jt+1)+dhm(4)*
p(
in(jr)+2,4))
15800 IF(
p(
in(jr)+2,4).GT.
p(
in(jr)+2,3))
THEN
15801 p(
in(jr)+2,4)=
p(
in(jr)+2,3)
15804 IF(js*
in(jr).GT.js*
in(4*jr)) goto 640
15805 IF(four(
in(1),
in(2)).LE.1
e-2)
THEN
15806 p(
in(jt)+2,4)=
p(
in(jt)+2,3)
15811 ELSEIF(
p(
in(jt)+2,4).GT.
p(
in(jt)+2,3))
THEN
15812 p(
in(jt)+2,4)=
p(
in(jt)+2,3)
15821 p(
n+nrs,j)=
p(
n+nrs,j)-
p(i,j)
15823 IF(
p(i,4).LT.
p(i,5)) goto 640
15829 IF(
in(3).NE.
in(3*jt+3))
THEN
15831 p(
in(3*jt+3),j)=
p(
in(3),j)
15832 p(
in(3*jt+3)+1,j)=
p(
in(3)+1,j)
15837 p(
in(jq)+2,3)=
p(
in(jq)+2,3)-
p(
in(jq)+2,4)
15838 p(
in(jq)+2,jt)=
p(
in(jq)+2,jt)-js*(3-2*jq)*
p(
in(jq)+2,4)
15848 CALL
lukfdi(kfl(jr),-kfl(3),kfldmp,k(i,2))
15849 IF(k(i,2).EQ.0) goto 640
15851 pr(jr)=
p(i,5)**2+(
px(jr)-
px(3))**2+(
py(jr)-
py(3))**2
15855 IF(
p(
in(4)+2,3)*
p(
in(5)+2,3)*four(
in(4),
in(5)).LT.
p(
in(7),3)*
15856 +
p(
in(8),3)*four(
in(7),
in(8))) jq=2
15857 dhc12=four(
in(3*jq+1),
in(3*jq+2))
15858 dhr1=four(
n+nrs,
in(3*jq+2))/dhc12
15859 dhr2=four(
n+nrs,
in(3*jq+1))/dhc12
15860 IF(
in(4).NE.
in(7).OR.
in(5).NE.
in(8))
THEN
15861 px(3-jq)=-four(
n+nrs,
in(3*jq+3))-
px(jq)
15862 py(3-jq)=-four(
n+nrs,
in(3*jq+3)+1)-
py(jq)
15863 pr(3-jq)=
p(i+(jt+jq-3)**2-1,5)**2+(
px(3-jq)+(2*jq-3)*js*
15864 +
px(3))**2+(
py(3-jq)+(2*jq-3)*js*
py(3))**2
15868 wrem2=wrem2+(
px(1)+
px(2))**2+(
py(1)+
py(2))**2
15870 IF(mju(1)+mju(2).NE.0.AND.i.EQ.isav+2.AND.
fd.GE.1.) goto 200
15871 IF(
fd.GE.1.) goto 640
15872 fa=wrem2+pr(jt)-pr(jr)
15873 IF(mstj(11).NE.2) prev=0.5*
exp(max(-50.,
log(
fd)*parj(38)*
15874 +(pr(1)+pr(2))**2))
15875 IF(mstj(11).EQ.2) prev=0.5*
fd**parj(39)
15876 fb=sign(
sqrt(max(0.,fa**2-4.*wrem2*pr(jt))),js*(
rlu(0)-prev))
15879 IF(max(
mod(kfl1a,10),
mod(kfl1a/1000,10),
mod(kfl2a,10),
15880 +
mod(kfl2a/1000,10)).GE.6) fb=sign(
sqrt(max(0.,fa**2-
15881 +4.*wrem2*pr(jt))),float(js))
15884 + jq+3)+1,j)+0.5*(dhr1*(fa+fb)*
p(
in(3*jq+1),j)+ dhr2*(fa-fb)*
15885 +
p(
in(3*jq+2),j))/wrem2
15886 p(i,j)=
p(
n+nrs,j)-
p(i-1,j)
15888 IF(
p(i-1,4).LT.
p(i-1,5).OR.
p(i,4).LT.
p(i,5)) goto 640
15892 DO 960 i=nsav+1,nsav+np
15895 IF(mstu(16).NE.2)
THEN
15915 p(nsav,5)=
sqrt(max(0d0,dps(4)**2-dps(1)**2-dps(2)**2-dps(3)**2))
15919 k(i,j)=k(i+nrs-1,j)
15920 p(i,j)=
p(i+nrs-1,j)
15925 DO 1000
iz=mstu90+1,mstu91
15926 mstu9t(
iz)=mstu(90+
iz)-nrs+1-nsav+
n
15927 paru9t(
iz)=paru(90+
iz)
15934 k(i-nsav+
n,j)=k(i,j)
15935 p(i-nsav+
n,j)=
p(i,j)
15939 DO 1050 i=
n+1,2*
n-nsav
15940 IF(k(i,3).NE.ie(1)) goto 1050
15946 IF(mstu(16).NE.2) k(i1,3)=nsav
15947 DO 1040
iz=mstu90+1,mstu91
15948 IF(mstu9t(
iz).EQ.i)
THEN
15949 mstu(90)=mstu(90)+1
15950 mstu(90+mstu(90))=i1
15951 paru(90+mstu(90))=paru9t(
iz)
15955 DO 1080 i=2*
n-nsav,
n+1,-1
15956 IF(k(i,3).EQ.ie(1)) goto 1080
15962 IF(mstu(16).NE.2) k(i1,3)=nsav
15963 DO 1070
iz=mstu90+1,mstu91
15964 IF(mstu9t(
iz).EQ.i)
THEN
15965 mstu(90)=mstu(90)+1
15966 mstu(90+mstu(90))=i1
15967 paru(90+mstu(90))=paru9t(
iz)
15975 CALL ludbrb(nsav+1,
n,0.,0.,dps(1)/dps(4),dps(2)/dps(4),
15979 hhpmt=
p(i,1)**2+
p(i,2)**2+
p(i,5)**2
15980 IF(
p(i,3).GT.0.)
THEN
15981 hhpez=(
p(i,4)+
p(i,3))*hhbz
15982 p(i,3)=0.5*(hhpez-hhpmt/hhpez)
15983 p(i,4)=0.5*(hhpez+hhpmt/hhpez)
15985 hhpez=(
p(i,4)-
p(i,3))/hhbz
15986 p(i,3)=-0.5*(hhpez-hhpmt/hhpez)
15987 p(i,4)=0.5*(hhpez+hhpmt/hhpez)
16017 dimension ipalup(4232),ipalum(4232)
16025 DATA ipalup/4232*0/
16026 DATA ipalum/4232*0/
16125 IF (
lutoge .EQ. 0.AND.abs(kf).GT.10)
THEN
16126 WRITE(*,*)
' +++ LUTOGE: UNKNOWN LUND CODE',kf,
' - GEANTINO '
16137 SUBROUTINE lwbb(ENU)
16142 DATA emean,slope,emin,emax/30.,0.02,12.,300./
16144 a2=
exp(emean*slope)
16146 IF(enu.LT.emean)
THEN
16149 e=a2*
exp(-enu*slope)
16151 IF(enu.LT.emin.OR.enu.GT.emax) goto 10
16152 IF(
e.LT.
rlu(0)) goto 10
16162 SUBROUTINE lweits(LFILE)
16169 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
16170 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
16171 COMMON /loptim/ optx(4),opty(4),optq2(4),optw2(4),comfac
16172 COMMON /lgrid/ nxx,nww,
xx(20),ww(15),pqg(20,15,3),pqqb(20,15,2),
16173 +qgmax(20,15,3),qqbmax(20,15,2),ycut(20,15),xtot(20,15),np
16174 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
16175 dimension wwi(15,4),xxi(20,4)
16177 DATA wwi/5.,6.,7.,8.,9.,10.,11.,12.,13.,14.,15.,17.5,20.,22.5,25.,
16178 +5.,7.5,10.,12.5,15.,17.5,20.,22.5,25.,27.5,30.,32.5,35.,40.,45.,
16179 +5.,10.,20.,30.,50.,75.,100.,125.,150.,175.,200.,225.,250.,300.,
16180 +350.,5.,10.,20.,35.,60.,100.,150.,225.,350.,500.,700.,1000.,
16181 +1400.,1900.,2500./
16183 +.001,.002,.004,.006,.008,.01,.02,.04,.06,.08,
16184 + .1,.125,.15,.2,.25,.3,.45,.6,.75,.99,
16185 +.001,.002,.004,.006,.008,.01,.02,.04,.06,.08,
16186 + .1,.125,.15,.2,.25,.3,.45,.6,.75,.99,
16187 +.0001,.0003,.0006,.001,.0025,.0050,.0075,
16188 + .01,.02,.04,.06,.08,.1,.125,.15,.2,.3,.5,.75,.99,
16189 +.0001,.0003,.0006,.001,.0025,.0050,.0075,
16190 + .01,.02,.04,.06,.08,.1,.125,.15,.2,.3,.5,.75,.99/
16196 wmax=
sqrt(parl(21))
16198 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10000)
16199 +parl(11),lst(13),mstu(112),paru(112), parl(8),parl(9),parl(12),
16201 IF(lst(17).EQ.0)
THEN
16204 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10100)
16207 IF(lst(23).EQ.1) np=2
16209 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10200)
16212 IF(lst(19).GE.1.AND.lst(19).LE.4)
THEN
16215 10 ww(iw)=wwi(iw,lst(19))
16217 20
xx(ix)=xxi(ix,lst(19))
16220 WRITE(6,*)
' Read next nww,nxx '
16222 READ(5,*) (ww(iw),iw=1,nww)
16223 READ(5,*) (
xx(ix),ix=1,nxx)
16224 IF(
xx(nxx).GT..99)
xx(nxx)=.99
16226 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10300)
16227 +lst(19),nww,nxx,ww,
xx
16228 IF(wmax.GT.ww(nww))
THEN
16229 IF(lst(3).GE.1)
WRITE(6,10400) wmax,ww(nww)
16230 IF(lst(3).GE.2)
THEN
16235 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10500)
16240 IF(lw.GT.0) goto 80
16241 IF(w.GT.wmax) lw=lw+1
16246 IF(lx.GT.0) goto 70
16247 IF(
x.GT.1.-w2/wmax**2) lx=lx+1
16249 pqcom=pari(31)*pq(17)*comfac
16254 parl(27)=max(parl(9)**2/w2,parl(8))
16260 xpmin=dble(
x)/(1.d0-2.d0*(1.d0-dble(
x))*dble(parl(27)))
16261 xpmax=dble(
x)/(dble(
x)+(1.d0-dble(
x))*dble(parl(27)))
16262 IF(xpmin.GE.xpmax) goto 50
16264 IF(xpmin.LE.0.) goto 50
16266 IF(lst(17).EQ.0)
THEN
16273 IF(ip.LE.2) pari(17+ip)=0.
16281 pqg(ix,iw,ip)=
result/parl(25)
16282 IF(lst(17).EQ.0)
THEN
16283 qgmax(ix,iw,1)=pari(15)
16284 qgmax(ix,iw,2)=pari(16)
16286 pqg(ix,iw,ip)=
result*pari(20)/pari(23+ip)/parl(25)
16287 qgmax(ix,iw,ip)=pari(14+ip)
16289 IF(ip.EQ.3) goto 40
16295 pqqb(ix,iw,ip)=
result/parl(25)
16296 IF(lst(17).EQ.0)
THEN
16297 qqbmax(ix,iw,1)=pari(18)
16298 qqbmax(ix,iw,2)=pari(19)
16300 pqqb(ix,iw,ip)=
result*pari(20)/pari(23+ip)/parl(25)
16301 qgmax(ix,iw,ip)=pari(17+ip)
16311 pot=
sqrt(1./(rqg+rqqb))
16312 parl(27)=(1./parl(12)+0.01)*(parl(12)*parl(27))**pot
16315 ELSEIF(iycut.GT.1.AND.rq.GT.parl(13))
THEN
16317 parl(27)=(parl(27)+yclow)/2.
16321 ycut(ix,iw)=parl(27)
16322 IF(lst(39).EQ.-91)
THEN
16329 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,
16330 + 10600) w,
x,
y,q2,parl(25),pqcom,parl(27),iycut, rq,rqg,rqqb,
16331 + (qgmax(ix,iw,ip),ip=1,ipmax), (qqbmax(ix,iw,ip),ip=1,min(2,
16338 IF(lfile.LT.0)
THEN
16340 WRITE(iabs(lfile)) lst,parl,nxx,nww,np,
xx,ww
16341 WRITE(iabs(lfile))(((pqg(ix,iw,ip),ix=1,nxx),iw=1,nww),ip=1,np),
16342 + (((pqqb(ix,iw,ip),ix=1,nxx),iw=1,nww),ip=1,np),
16343 + (((qgmax(ix,iw,ip),ix=1,nxx),iw=1,nww),ip=1,ipmax),
16344 + (((qqbmax(ix,iw,ip),ix=1,nxx),iw=1,nww),ip=1,min(2,ipmax)),
16346 IF(np.NE.1)
WRITE(iabs(lfile)) xtot
16351 10000
FORMAT(
'1',/,5
x,
'INTEGRATION OF 1ST ORDER QCD MATRIX ELEMENTS',
16352 + /,5
x,
'============================================',
16353 +/,
' FOR GLUON RADIATION (QG-EVENT) AND BOSON-GLUON FUSION ',
16354 +
'(QQ-EVENT) PROBABILITY.',
16355 +//,
' REQUIRED PRECISION IN INTEGRATION, PARL(11) =',f8.4,
16356 +//,
' HEAVIEST FLAVOUR PRODUCED IN BOSON-GLUON FUSION, LST(13) =',
16357 +i5,//,
' ALPHA-STRONG PARAMETERS: # FLAVOURS, MSTU(112) =',i3,
16358 +/,25
x,
' QCD LAMBDA, PARU(112) =',f6.3,
' GEV',
16359 +//,
' CUTS ON MATRIX ELEMENTS:',
16360 +/,
' PARL(8), PARL(9), PARL(12), PARL(13) =',4f8.4,/)
16361 10100
FORMAT(
' LEPTON ENERGY NOT ALLOWED TO VARY IN SIMULATION.',/)
16362 10200
FORMAT(
' LEPTON ENERGY ALLOWED TO VARY IN SIMULATION, ',/,
16363 +
' Y IN TABLE BELOW CALCULATED ASSUMING MAX ENERGY.',/)
16364 10300
FORMAT(
' GRID CHOICE, LST(19) =',i3,5
x,
'# GRID POINTS IN W, X =',
16365 +2i5,/,
' W-VALUES IN ARRAY WW:',/,10f8.1,/,5f8.1,
16366 +/,
' X-VALUES IN ARRAY XX:',/,10f8.4,/,10f8.4,/)
16367 10400
FORMAT(
' WARNING: MAX W OUTSIDE GRID, WMAX, GRID-MAX =',2f12.1)
16368 10500
FORMAT(//,6
x,
'W',7
x,
'X',7
x,
'Y',6
x,
'Q**2',1
x,
'ALPHA',1
x,
'DSIGMA',
16369 +9
x,
'CUT',
' IT',2
x,
'Q-EVENT',1
x,
'QG-EVENT',
16370 +1
x,
'QQ-EVENT',
' MAX OF MATRIX ELEMENTS QG & QQ; L,R OR T,S,I',
16372 10600
FORMAT(f7.1,2f8.4,1pg10.3,0pf6.2,1pg11.3,0pf8.4,i3,3f9.4,1
p,5e9.2)
16373 10700
FORMAT(
' EXECUTION STOPPED ',/)
16380 SUBROUTINE lxp(XP,IFAIL)
16385 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
16386 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
16387 DOUBLE PRECISION dxpmax
16390 xpmin=dble(
x)/(1.d0-2.d0*(1.d0-dble(
x))*dble(parl(27)))
16391 dxpmax=dble(
x)/(dble(
x)+(1.d0-dble(
x))*dble(parl(27)))
16393 IF(xpmin.GE.xpmax)
RETURN
16395 bp=(1.d0-dxpmax)/ap
16396 IF(lst(24).EQ.2)
THEN
16398 IF(lst(17).NE.0) qxpmax=pari(24)*pari(15)+pari(25)*pari(16)+
16399 + pari(26)*pari(17)
16402 IF(lst(17).NE.0) qxpmax=pari(24)*pari(18)+pari(25)*pari(19)
16408 IF(loop.GT.1000)
RETURN
16409 xp=1.-ap*bp**
rlu(0)
16410 xpweit=
dsigma(xp)/qxpmax
16411 IF(xpweit.LT.
rlu(0)) goto 10
16426 COMMON /linteg/ ntot,npass
16427 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
16428 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
16429 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
16430 DOUBLE PRECISION acc,
value,erriw,flow,fhigh
16431 COMMON /params/ acc,ndim,nsub,iter
16432 COMMON /answer/
value,erriw
16433 COMMON /bndlmt/ flow,fhigh
16434 COMMON /sample/ npoint
16435 dimension xminus(2),xplus(2)
16437 common/linpatch/ncalls,ncall
16467 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10000)
16468 IF(lst(10).EQ.1)
THEN
16470 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10100)
16476 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10200)
16477 + it,ntot,npass,sigma
16478 IF(sigma.GT.1.)
THEN
16479 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,
16482 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,
16483 + 10400) accur,accur/max(1.
e-22,sigma),parl(15)
16484 accur=max(1.
e-22,sigma*parl(15))
16485 IF(it.LT.2) goto 20
16487 ELSEIF(lst(10).EQ.2)
THEN
16492 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10500)
16493 + sngl(acc),nsub,iter
16497 ELSEIF(lst(10).EQ.3)
THEN
16502 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10600)
16503 + eps,maxnum,sngl(flow),sngl(fhigh),npoint
16504 CALL divon(ndim,xminus,xplus,eps,maxnum,sigma,errest)
16505 ELSEIF(lst(10).EQ.4)
THEN
16510 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1))
WRITE(6,10700)
16511 + eps,maxnum, sngl(flow),sngl(fhigh),npoint,sprdmx,maxpts,jdeg,
16513 CALL partn(ndim,xminus,xplus,sprdmx,maxpts)
16514 CALL intgrl(ndim,jdeg,npt,sigma,errest)
16516 IF(lst(3).GE.1)
WRITE(6,*)
' WARNING: LST(10) = ',lst(10),
16520 IF(lst(3).GE.4.OR.(lst(3).EQ.3.AND.ncall.EQ.1)
16521 +.OR.(lst(3).GE.1.AND.npass.EQ.0))
THEN
16522 WRITE(6,10800) sigma,errest,ntot,npass,ti2-ti1
16523 IF(lst(3).GE.1.AND.npass.EQ.0)
WRITE(6,10900)
16528 10000
FORMAT(/,
' INTEGRATION OF CROSS SECTION:',/,1
x,28(
'-'))
16529 10100
FORMAT(5
x,
'USING GADAP = ADAPTIVE GAUSSIAN INTEGRATION')
16530 10200
FORMAT(5
x,
'ITERATION #',i3,/,
16531 +10
x,
'# FUNCTION EVALUATIONS; TOTAL & NON-ZERO =',2i8,/,
16532 +10
x,
'SIGMA =',g10.2,
' PB')
16533 10300
FORMAT(10
x,
'REQUIRED RELATIVE ERROR = ',g10.2)
16534 10400
FORMAT(10
x,
'EFFECTIVE ABSOLUTE ERROR = ',g10.2,/,
16535 + 10
x,
'EFFECTIVE RELATIVE ERROR = ',g10.2,/,
16536 + 10
x,
'REQUIRED RELATIVE ERROR = ',g10.2)
16537 10500
FORMAT(5
x,
'USING RIWIAD WITH PARAMETERS: REL. ACC. = ',f10.4,
16538 +/,5
x,
'# OF SUBVOLUMES = ',i5,5
x,
'MAX # ITERATIONS = ',i5)
16539 10600
FORMAT(5
x,
'USING AUTOMATIC DIVONNE WITH PARAMETERS: ',
16540 +
'REL. ACC. = ',f10.4,/,5
x,
'MAX # FUNCTION CALLS = ',i5,
16541 +/,5
x,
'LOWER AND UPPER BOUND ON INTEGRAND =',2e12.4,
16542 +/,5
x,
'# SAMPLE POINTS/REGION =',i5)
16543 10700
FORMAT(5
x,
'USING DETAILED DIVONNE WITH PARAMETERS: ',
16544 +
'REL. ACC. = ',f10.4,/,5
x,
'MAX # FUNCTION CALLS = ',i5,
16545 +/,5
x,
'LOWER AND UPPER BOUND ON INTEGRAND =',2e12.4,
16546 +/,5
x,
'# SAMPLE POINTS/REGION =',i5,
16547 +/,5
x,
'SPRDMX, MAXPTS, JDEG, NPT =',f5.2,3i10)
16548 10800
FORMAT(/,
' ===> CROSS-SECTION =',1
p,g12.3,
16549 +
' PB, ERROR ESTIMATE = ',g12.3,/,
16550 +6
x,
'# OF INTEGRAND EVALUATIONS; TOTAL & NON-ZERO =',2i8,/,
16551 +6
x,
'CPU TIME FOR INTEGRATION =',g12.3,
' SECONDS',/)
16552 10900
FORMAT(
' WARNING: INTEGRAND ALWAYS ZERO, PROBABLY NO ALLOWED',
16553 +
' PHASE SPACE DUE TO CUTS',/,
16554 +10
x,
'CHECK, IN PARTICULAR, CUT(11) TO CUT(14)')
16561 SUBROUTINE lzp(XP,ZP,IFAIL)
16565 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
16566 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
16567 DATA c1,c2/0.2122066,0.0795775/,dzpmax,szp,cp/3*0./
16571 fqq(
dz,
dx,da,db,dc,dd,de)=da*dd*(
dz**2+(1.-
dz)**2)+db*de*
dz*
16572 &(1.-
dz)+dc*dd*(2.*
dz-1.)
16576 IF(lst(30).EQ.1) ih=2
16577 zpmin=(1.-
x)*xp/(xp-
x)*parl(27)
16578 IF(zpmin.GE.0.5)
RETURN
16583 IF(lst(23).EQ.2)
THEN
16586 csign=-lst(30)*isign(1,lst(25))*pari(26)
16588 a=(ewqc(1,ih,i)+ewqc(2,ih,i))*pari(24)
16589 b=(ewqc(1,ih,i)+ewqc(2,ih,i))*pari(25)
16590 c=(ewqc(1,ih,i)-ewqc(2,ih,i))*pari(26)
16591 csign=-c*lst(30)*isign(1,lst(25))
16593 IF(lst(24).EQ.2)
THEN
16594 dzpmax=max(fqg(zpmin,xp,
a,b,csign),fqg(zpmax,xp,
a,b,csign))
16595 aa=2.*(
a+csign)/(1.-xp)-4.*
a*xp-8.*b*xp-4.*csign
16596 IF(abs(aa).GT.1.
e-20)
THEN
16597 bb=2.*
a*(xp-1.)+4.*b*xp+2.*csign*(1.-xp)
16599 IF(z1.GT.zpmin.AND.z1.LT.zpmax)
THEN
16600 dzpmax=max(dzpmax,fqg(z1,xp,
a,b,csign))
16603 dzpmax=dzpmax*
c1*1.05
16604 ELSEIF(lst(24).EQ.3)
THEN
16608 dzpmax=max(fqq(zpmin,xp,
a,b,csign,
d,
e),
16609 & fqq(zpmax,xp,
a,b,csign,
d,
e))
16611 IF(abs(aa).GT.1.
e-20)
THEN
16612 bb=b*
e-2.*
a*
d+2.*csign*
d
16614 IF(z1.GT.zpmin.AND.z1.LT.zpmax)
THEN
16615 dzpmax=max(dzpmax,fqq(z1,xp,
a,b,csign,
d,
e))
16618 dzpmax=dzpmax*c2*1.05
16623 IF(loop.GT.1000)
RETURN
16624 IF(lst(24).EQ.2)
THEN
16625 zp=1.-ap*bp**
rlu(0)
16627 ELSEIF(lst(24).EQ.3)
THEN
16632 zpweit=szp*(
a*
dqcd(0,
ipart,1,xp,zp,0.)+b*
dqcd(0,
ipart,2,xp,zp,0.)
16633 &+csign*
dqcd(0,
ipart,3,xp,zp,0.))/dzpmax
16634 IF(zpweit.LT.
rlu(0)) goto 10
16650 parameter(nnq=1000000)
16652 dimension lq(nnq),iq(nnq),q(nnq)
16653 equivalence(q(1),iq(1),lq(9),jstruc(8))
16654 COMMON /quest/iquest(100)
16655 COMMON /xqstor/ixevt,ifence(16),jgeev,jstruc(99),jrefer(100),
16657 COMMON /fzlun/lunfz
16658 common/mzioall/iogenf
16661 common/infonew/irdate,irtime
16666 CALL mzform(
'GENF',
'5I 2H',iogenf)
16675 SUBROUTINE orth(PO,P,PB)
16679 REAL*4 bdir(3),pb2(3),
p(3),pb(3),pv(3)
16689 bdirl=
sqrt(bdir(1)**2+bdir(2)**2+bdir(3)**2)
16696 bdir(i)=bdir(i)/bdirl
16697 pbdb=pbdb+pb(i)*bdir(i)
16701 pb2(i)=pb(i) - pbdb*bdir(i)
16705 pb2l=
sqrt(pb2(1)**2+pb2(2)**2+pb2(3)**2)
16706 IF (pb2l.EQ.0)
THEN
16729 pv(i)=
p(i)-a1*bdir(i)-a2*pb2(i)
16747 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
16748 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
16749 +q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
16750 COMMON /linter/ pari(40),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
16754 parameter(icento=100)
16758 parameter(lux_level=4)
16759 INTEGER*4 jtau(100),jpri(100),jstro(100)
16760 REAL*4 ftuple(isiz)
16761 common/jettagl/jtau,jpri,jstro
16762 common/ntupla/ftuple,isfirst
16763 common/beam/spec(icento)
16764 COMMON /maxspec/rmaxspec,rintspec
16765 common/sav/xminsav(icento),xmaxsav(icento),yminsav(icento),
16766 & ymaxsav(icento),q2minsav(icento),q2maxsav(icento),
16767 & w2minsav(icento),w2maxsav(icento),parimax(icento),
16768 & ppsave(icento,3,4,5),paricor(icento),
index,sigmasav(icento),
16774 IF (pari(32).NE.paricor(
index))
THEN
16775 paricor(
index)=pari(32)
16776 parimax(
index)=pari(lst(23))
16785 FUNCTION phint(IDUM)
16810 parameter(nmxpho=2000)
16811 INTEGER idpho,istpho,jdapho,jmopho,nevpho,npho
16813 common/phoevt/nevpho,npho,istpho(nmxpho),idpho(nmxpho),
16814 +jmopho(2,nmxpho),jdapho(2,nmxpho),ppho(5,nmxpho),vpho(4,nmxpho)
16815 DOUBLE PRECISION mchsqr,mnesqr
16817 common/phomom/mchsqr,mnesqr,pneutr(5)
16818 DOUBLE PRECISION costhg,sinthg
16820 common/phophs/xphmax,xphoto,costhg,sinthg
16825 DO k=jdapho(2,1),jdapho(1,1),-1
16826 IF(idpho(k).NE.22)
THEN
16833 ifint= npho.GT.
ident
16835 ifint= ifint.AND.(
ident-jdapho(1,1)).EQ.1
16837 ifint= ifint.AND.idpho(jdapho(1,1)).EQ.-idpho(
ident)
16842 mpasqr = ppho(5,1)**2
16843 xx=4.*mchsqr/mpasqr*(1.-xphoto)/(1.-xphoto+(mchsqr-mnesqr)/
16855 SUBROUTINE phlupa(IPOINT)
16873 parameter(nmxpho=2000)
16874 INTEGER idpho,istpho,jdapho,jmopho,nevpho,npho
16876 common/phoevt/nevpho,npho,istpho(nmxpho),idpho(nmxpho),
16877 +jmopho(2,nmxpho),jdapho(2,nmxpho),ppho(5,nmxpho),vpho(4,nmxpho)
16880 common/pholun/phlun
16882 IF (ipoint.LT.3000)
RETURN
16884 IF (iev.LT.1000)
THEN
16888 WRITE(phlun,*)
'EVENT NR=',iev,
'WE ARE TESTING /PHOEVT/ AT '
16889 + //
'IPOINT=',ipoint
16892 WRITE(phlun,10100) idpho(i),ppho(1,i),ppho(2,i),ppho(3,i),
16893 + ppho(4, i),ppho(5,i),jdapho(1,i),jdapho(2,i)
16895 WRITE(phlun,10100) idpho(i),ppho(1,i),ppho(2,i),ppho(3,i),
16896 + ppho(4, i),ppho(5,i),jdapho(1,i),jdapho(2,i)
16899 WRITE(phlun,10100) idpho(i),ppho(1,i),ppho(2,i),ppho(3,i),
16900 + ppho(4,i),ppho(5,i),jmopho(1,i),jmopho(2,i)
16902 sum(j)=sum(j)+ppho(j,i)
16905 sum(5)=
sqrt(abs(sum(4)**2-sum(1)**2-sum(2)**2-sum(3)**2))
16906 WRITE(phlun,10200) sum
16907 10000
FORMAT(1
x,
' ID ',
'P_X ',
'P_Y ',
'P_Z ',
16909 +
'ID-MO_DA1',
'ID-MO DA2' )
16910 10100
FORMAT(1
x,i4,5(f9.3),2i9)
16911 10200
FORMAT(1
x,
' SUM',5(f9.3))
16935 common/phpico/pi,twopi
16936 IF (abs(
y).LT.abs(
x))
THEN
16966 common/phpico/pi,twopi
16967 IF (abs(
y).LT.abs(
x))
THEN
16977 SUBROUTINE phobo3(ANGLE,PVEC)
16994 DOUBLE PRECISION qpl,qmi,
angle
16996 qpl=(pvec(4)+pvec(3))*
angle
16997 qmi=(pvec(4)-pvec(3))/
angle
16998 pvec(3)=(qpl-qmi)/2.
16999 pvec(4)=(qpl+qmi)/2.
17006 SUBROUTINE phobos(IP,PBOOS1,PBOOS2,FIRST,LAST)
17030 DOUBLE PRECISION bet1(3),bet2(3),gam1,gam2,pb,
data
17031 INTEGER i,j,
first,
last,maxsta,nstack,ip
17032 parameter(maxsta=2000)
17033 INTEGER stack(maxsta)
17034 REAL pboos1(5),pboos2(5)
17036 parameter(nmxhep=2000)
17037 INTEGER idhep,isthep,jdahep,jmohep,nevhep,nhep
17038 DOUBLE PRECISION phep,vhep
17039 common/
hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
17040 +jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
17044 bet1(j)=-pboos1(j)/pboos1(5)
17045 10 bet2(j)=pboos2(j)/pboos2(5)
17046 gam1=pboos1(4)/pboos1(5)
17047 gam2=pboos2(4)/pboos2(5)
17051 pb=bet1(1)*phep(1,i)+bet1(2)*phep(2,i)+bet1(3)*phep(3,i)
17052 IF (jmohep(1,i).EQ.ip)
THEN
17054 30 phep(j,i)=phep(j,i)+bet1(j)*(phep(4,i)+pb/(gam1+1.))
17055 phep(4,i)=gam1*phep(4,i)+pb
17058 pb=bet2(1)*phep(1,i)+bet2(2)*phep(2,i)+bet2(3)*phep(3,i)
17060 40 phep(j,i)=phep(j,i)+bet2(j)*(phep(4,i)+pb/(gam2+1.))
17061 phep(4,i)=gam2*phep(4,i)+pb
17062 IF (jdahep(1,i).NE.0)
THEN
17066 IF (nstack.GT.maxsta)
THEN
17074 IF (nstack.NE.0)
THEN
17077 first=jdahep(1,stack(nstack))
17078 last=jdahep(2,stack(nstack))
17107 INTEGER idhep,idabs,q1,q2,q3
17113 &-0.3333333333, 0.6666666667, -0.3333333333, 0.6666666667,
17114 &-0.3333333333, 0.6666666667, -0.3333333333, 0.6666666667,
17115 & 2*0., -1., 0., -1., 0., -1., 0., -1., 6*0., 1., 12*0., 1., 63*0./
17117 IF (idabs.LE.100)
THEN
17124 q3=
mod(idabs/1000,10)
17125 q2=
mod(idabs/100,10)
17126 q1=
mod(idabs/10,10)
17130 IF(
mod(q2,2).EQ.0)
THEN
17131 phocha=charge(q2)-charge(q1)
17133 phocha=charge(q1)-charge(q2)
17138 phocha=charge(q1)+charge(q2)+charge(q3)
17150 SUBROUTINE phochk(JFIRST)
17168 parameter(nmxpho=2000)
17169 INTEGER idpho,istpho,jdapho,jmopho,nevpho,npho
17171 common/phoevt/nevpho,npho,istpho(nmxpho),idpho(nmxpho),
17172 +jmopho(2,nmxpho),jdapho(2,nmxpho),ppho(5,nmxpho),vpho(4,nmxpho)
17174 common/phoif/chkif(nmxpho)
17176 parameter(nmxhep=2000)
17178 common/phoqed/qedrad(nmxhep)
17181 INTEGER idabs,nlast,i,ippar
17182 LOGICAL interf,isec,iftop
17184 COMMON /phokey/ interf,fint,isec,fsec,iftop
17189 + ( ((idabs.GT.9).AND.(idabs.LE.40)) .OR. (idabs.GT.100) )
17190 + .AND.(idabs.NE.21)
17191 + .AND.(idabs.NE.2101).AND.(idabs.NE.3101).AND.(idabs.NE.3201)
17192 + .AND.(idabs.NE.1103).AND.(idabs.NE.2103).AND.(idabs.NE.2203)
17193 + .AND.(idabs.NE.3103).AND.(idabs.NE.3203).AND.(idabs.NE.3303)
17199 DO 10 i=ippar,nlast
17200 idabs = abs(idpho(i))
17202 chkif(i)=
f(idabs) .AND.
f(abs(idpho(1))) .AND. (idpho(2).EQ.0)
17203 IF(i.GT.2) chkif(i)=chkif(i).AND.qedrad(jfirst+i-ippar-2)
17210 DO k=jdapho(2,1),jdapho(1,1),-1
17211 IF(idpho(k).NE.22)
THEN
17217 ifrad=((idpho(1).EQ.21).AND.(idpho(2).EQ.21))
17218 + .OR. ((abs(idpho(1)).LE.6).AND.((idpho(2)).EQ.(-idpho(1))))
17220 + .AND.(abs(idpho(3)).EQ.6).AND.((idpho(4)).EQ.(-idpho(3)))
17221 + .AND.(
ident.EQ.4)
17223 DO 30 i=ippar,nlast
17225 IF(i.GT.2) chkif(i)=chkif(i).AND.qedrad(jfirst+i-ippar-2)
17233 DO k=jdapho(2,1),jdapho(1,1),-1
17234 IF(idpho(k).NE.22)
THEN
17240 ifrad=((abs(idpho(1)).EQ.6).AND.(idpho(2).EQ.0))
17242 + .AND.((abs(idpho(3)).EQ.24).AND.(abs(idpho(4)).EQ.5)
17243 + .OR.(abs(idpho(3)).EQ.5).AND.(abs(idpho(4)).EQ.24))
17244 + .AND.(
ident.EQ.4)
17246 DO 50 i=ippar,nlast
17248 IF(i.GT.2) chkif(i)=chkif(i).AND.qedrad(jfirst+i-ippar-2)
17275 parameter(nmxhep=2000)
17277 common/phoqed/qedrad(nmxhep)
17279 common/pholun/phlun
17281 common/phocop/alpha,xphcut
17283 common/phpico/pi,twopi
17284 INTEGER iseed,i97,j97
17285 REAL uran,cran,cdran,cmran
17286 common/phseed/iseed(2),i97,j97,uran(97),cran,cdran,cmran
17288 parameter(phomes=10)
17290 common/phosta/
status(phomes)
17291 LOGICAL interf,isec,iftop
17293 COMMON /phokey/ interf,fint,isec,fsec,iftop
17299 IF (
init.NE.0)
RETURN
17305 10 qedrad(i)=.true.
17314 alpha=0.00729735039
17315 pi=3.14159265358979324
17316 twopi=6.28318530717958648
17349 FUNCTION phocor(MPASQR,MCHREN,ME)
17373 DOUBLE PRECISION mchsqr,mnesqr
17375 common/phomom/mchsqr,mnesqr,pneutr(5)
17376 DOUBLE PRECISION costhg,sinthg
17378 common/phophs/xphmax,xphoto,costhg,sinthg
17380 REAL probh,corwt,xf
17381 common/phopro/irep,probh,corwt,xf
17384 xx=4.*mchsqr/mpasqr*(1.-xphoto)/(1.-xphoto+(mchsqr-mnesqr)/
17388 wt3=(1.-xphoto/xphmax)/((1.+(1.-xphoto/xphmax)**2)/2.)
17389 ELSEIF (me.EQ.2)
THEN
17390 yy=0.5*(1.-xphoto/xphmax+1./(1.-xphoto/xphmax))
17392 ELSEIF ((me.EQ.3).OR.(me.EQ.4).OR.(me.EQ.5))
THEN
17394 wt3=(1.+(1.-xphoto/xphmax)**2-(xphoto/xphmax)**3)/(1.+(1.
17395 & -xphoto/xphmax)** 2)
17403 wt1=(1.-costhg*
sqrt(1.-mchren))/(1.-costhg*
beta)
17404 wt2=(1.-
xx/
yy/(1.-
beta**2*costhg**2))*(1.+costhg*
beta)/2.
17418 SUBROUTINE phodo(IP,NCHARB,NEUDAU)
17443 DOUBLE PRECISION parne,qnew,qold,
data
17444 INTEGER ip,fi3dum,i,j,neudau,
first,
last
17446 REAL ephoto,pmavir,
photri
17447 REAL gneut,
phoran,ccosth,ssinth,pvec(4)
17449 parameter(nmxpho=2000)
17450 INTEGER idpho,istpho,jdapho,jmopho,nevpho,npho
17452 common/phoevt/nevpho,npho,istpho(nmxpho),idpho(nmxpho),
17453 +jmopho(2,nmxpho),jdapho(2,nmxpho),ppho(5,nmxpho),vpho(4,nmxpho)
17454 DOUBLE PRECISION mchsqr,mnesqr
17456 common/phomom/mchsqr,mnesqr,pneutr(5)
17457 DOUBLE PRECISION costhg,sinthg
17459 common/phophs/xphmax,xphoto,costhg,sinthg
17461 common/phpico/pi,twopi
17463 ephoto=xphoto*ppho(5,ip)/2.
17464 pmavir=
sqrt(ppho(5,ip)*(ppho(5,ip)-2.*ephoto))
17467 fi1=
phoan1(pneutr(1),pneutr(2))
17471 th1=
phoan2(pneutr(3),
sqrt(pneutr(1)**2+pneutr(2)**2))
17472 CALL
phoro3(-fi1,pneutr(1))
17473 CALL
phoro2(-th1,pneutr(1))
17481 qnew=
photri(pmavir,pneutr(5),ppho(5,ncharb))
17483 gneut=(qnew**2+qold**2+mnesqr)/(qnew*qold+
sqrt((qnew**2+mnesqr)*
17484 +(qold**2+mnesqr)))
17485 IF (gneut.LT.1.)
THEN
17489 parne=gneut-
sqrt(max(gneut**2-1.0,0.))
17492 CALL
phobo3(parne,pneutr)
17503 ppho(4,npho)=ephoto*ppho(5,ip)/pmavir
17508 th3=
phoan2(ccosth,ssinth)
17509 fi3=twopi*
phoran(fi3dum)
17510 ppho(1,npho)=ppho(4,npho)*sinthg*
cos(fi3)
17511 ppho(2,npho)=ppho(4,npho)*sinthg*
sin(fi3)
17514 ppho(3,npho)=-ppho(4,npho)*costhg
17518 CALL
phoro3(-fi3,pneutr(1))
17519 CALL
phoro3(-fi3,ppho(1,npho))
17520 CALL
phoro2(-th3,pneutr(1))
17521 CALL
phoro2(-th3,ppho(1,npho))
17522 angle=ephoto/ppho(4,npho)
17529 fi4=
phoan1(pneutr(1),pneutr(2))
17530 th4=
phoan2(pneutr(3),
sqrt(pneutr(1)**2+pneutr(2)**2))
17531 CALL
phoro3(fi4,pneutr(1))
17532 CALL
phoro3(fi4,ppho(1,npho))
17541 CALL
phoro2(-th4,pneutr)
17542 CALL
phoro2(-th4,ppho(1,npho))
17544 fi5=
phoan1(pvec(1),pvec(2))
17547 CALL
phoro3(-fi5,pneutr)
17548 CALL
phoro3(-fi5,ppho(1,npho))
17549 CALL
phoro2(th1,pneutr(1))
17550 CALL
phoro2(th1,ppho(1,npho))
17552 CALL
phoro3(fi1,ppho(1,npho))
17554 IF ((jdapho(2,ip)-jdapho(1,ip)).GT.1)
THEN
17560 IF (i.NE.ncharb.AND.(jmopho(1,i).EQ.ip))
THEN
17563 CALL
phoro3(-fi1,ppho(1,i))
17564 CALL
phoro2(-th1,ppho(1,i))
17567 CALL
phobo3(parne,ppho(1,i))
17570 CALL
phoro3(-fi3,ppho(1,i))
17571 CALL
phoro2(-th3,ppho(1,i))
17577 CALL
phoro3(fi4,ppho(1,i))
17578 CALL
phoro2(-th4,ppho(1,i))
17581 CALL
phoro3(-fi5,ppho(1,i))
17582 CALL
phoro2(th1,ppho(1,i))
17583 CALL
phoro3(fi1,ppho(1,i))
17590 30 ppho(j,neudau)=pneutr(j)
17595 40 ppho(j,ncharb)=-(ppho(j,npho)+pneutr(j))
17596 ppho(4,ncharb)=ppho(5,ip)-(ppho(4,npho)+pneutr(4))
17602 SUBROUTINE phoene(MPASQR,MCHREN,BETA,IDENT)
17626 DOUBLE PRECISION mpasqr,mchren,biglog,
beta,
data
17627 INTEGER iwt1,irn,iwt2
17629 DOUBLE PRECISION mchsqr,mnesqr
17633 common/phomom/mchsqr,mnesqr,pneutr(5)
17634 DOUBLE PRECISION costhg,sinthg
17636 common/phophs/xphmax,xphoto,costhg,sinthg
17638 common/phocop/alpha,xphcut
17640 common/phpico/pi,twopi
17642 REAL probh,corwt,xf
17643 common/phopro/irep,probh,corwt,xf
17644 LOGICAL interf,isec,iftop
17646 COMMON /phokey/ interf,fint,isec,fsec,iftop
17648 IF (xphmax.LE.xphcut)
THEN
17653 mchren=4.*mchsqr/mpasqr/(1.+mchsqr/mpasqr)**2
17655 biglog=
log(mpasqr/mchsqr*(1.+
beta)**2/4.*(1.+mchsqr/mpasqr)**2)
17656 prhard=alpha/pi/
beta*biglog*(
log(xphmax/xphcut)-.75+xphcut/
17657 &xphmax-.25*xphcut**2/xphmax**2)
17659 IF (irep.EQ.0) probh=0.
17665 IF (prsoft.LT.0.1)
THEN
17669 IF (
phoran(iwt1).LT.prsoft)
THEN
17678 xphoto=xphoto*xphmax
17679 IF (
phoran(iwt2).GT.((1.+(1.-xphoto/xphmax)**2)/2.)) goto 10
17683 xf=4.*mchsqr*mpasqr/(mpasqr+mchsqr-mnesqr)**2
17690 SUBROUTINE phoerr(IMES,TEXT,DATA)
17707 DOUBLE PRECISION data
17708 INTEGER imes,ierror
17711 common/pholun/phlun
17713 parameter(phomes=10)
17715 common/phosta/
status(phomes)
17726 IF ((imes.EQ. 6).AND.(
status(imes).GE.2))
RETURN
17727 IF ((imes.EQ.10).AND.(
status(imes).GE.2))
RETURN
17731 goto(10,20,30,40,50,60,70,80,90,100),imes
17732 WRITE(phlun,11200) imes
17734 10
WRITE(phlun,10100) text,
int(sdata)
17736 20
WRITE(phlun,10200) text,sdata
17738 30
WRITE(phlun,10300) text,sdata
17740 40
WRITE(phlun,10400) text
17742 50
WRITE(phlun,10500) text,
int(sdata)
17744 60
WRITE(phlun,10600) text,sdata
17746 70
WRITE(phlun,10700) text,
int(sdata)
17748 80
WRITE(phlun,10800) text,
int(sdata)
17750 90
WRITE(phlun,10900) text,
int(sdata)
17752 100
WRITE(phlun,11000) text,sdata
17763 120 ierror=ierror+1
17764 IF (ierror.GE.10)
THEN
17774 130
WRITE(phlun,11100)
17777 10000
FORMAT(1h ,80(
'*'))
17778 10100
FORMAT(1h ,
'* ',
a,
': TOO MANY CHARGED PARTICLES, NCHARG =',i6,t81,
17780 10200
FORMAT(1h ,
'* ',
a,
': TOO MUCH BREMSSTRAHLUNG REQUIRED, PRSOFT = ',
17782 10300
FORMAT(1h ,
'* ',
a,
': COMBINED WEIGHT IS EXCEEDING 1., WEIGHT = ',
17784 10400
FORMAT(1h ,
'* ',
a,
17785 &
': ERROR IN RESCALING CHARGED AND NEUTRAL VECTORS',t81,
'*')
17786 10500
FORMAT(1h ,
'* ',
a,
17787 &
': NON MATCHING CHARGED PARTICLE POINTER, NCHARG = ',i5,t81,
'*')
17788 10600
FORMAT(1h ,
'* ',
a,
17789 &
': DO YOU REALLY WORK WITH A PARTICLE OF SPIN: ',
f4.1,
' ?',t81,
17791 10700
FORMAT(1h ,
'* ',
a,
': STACK LENGTH EXCEEDED, NSTACK = ',i5 ,t81,
17793 10800
FORMAT(1h ,
'* ',
a,
17794 &
': RANDOM NUMBER GENERATOR SEED(1) OUT OF RANGE: ',i8,t81,
'*')
17795 10900
FORMAT(1h ,
'* ',
a,
17796 &
': RANDOM NUMBER GENERATOR SEED(2) OUT OF RANGE: ',i8,t81,
'*')
17797 11000
FORMAT(1h ,
'* ',
a,
17798 &
': AVAILABLE PHASE SPACE BELOW CUT-OFF: ',f15.6,
' GEV/C^2',t81,
17800 11100
FORMAT(1h ,
'*',t81,
'*')
17801 11200
FORMAT(1h ,
'* FUNNY ERROR MESSAGE: ',i4,
' ! WHAT TO DO ?',t81,
'*')
17802 11300
FORMAT(1h ,
'* FATAL ERROR MESSAGE, I STOP THIS RUN !',t81,
'*')
17803 11400
FORMAT(1h ,
'* 10 ERROR MESSAGES GENERATED, I STOP THIS RUN !',t81,
17842 REAL probh,corwt,xf
17843 common/phopro/irep,probh,corwt,xf
17845 DATA prx,
ff/ 0., 0./
17846 IF (mode.EQ.0)
THEN
17847 IF (irep.EQ.0) prx=1.
17865 SUBROUTINE phoin(IP,BOOST,NHEP0)
17886 parameter(nmxhep=2000)
17887 INTEGER idhep,isthep,jdahep,jmohep,nevhep,nhep
17888 DOUBLE PRECISION phep,vhep
17889 common/
hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
17890 +jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
17892 parameter(nmxpho=2000)
17893 INTEGER idpho,istpho,jdapho,jmopho,nevpho,npho
17895 common/phoevt/nevpho,npho,istpho(nmxpho),idpho(nmxpho),
17896 +jmopho(2,nmxpho),jdapho(2,nmxpho),ppho(5,nmxpho),vpho(4,nmxpho)
17900 DOUBLE PRECISION bet(3),gam,pb
17901 COMMON /phocms/ bet,gam
17902 LOGICAL interf,isec,iftop
17904 COMMON /phokey/ interf,fint,isec,fsec,iftop
17916 ppho(i,1)=phep(i,ip)
17919 ip2=jmohep(2,jdahep(1,ip))
17920 IF((ip2.NE.0).AND.(ip2.NE.ip))
THEN
17921 idpho(2)=idhep(ip2)
17925 ppho(i,2)=phep(i,ip2)
17935 idpho(3+ll)=idhep(
first+ll)
17936 jmopho(1,3+ll)=jmohep(1,
first+ll)
17937 IF (jmohep(1,
first+ll).EQ.ip) jmopho(1,3+ll)=1
17939 ppho(i,3+ll)=phep(i,
first+ll)
17942 IF (nhep.GT.nhep0)
THEN
17946 idpho(na+ll)=idhep(nhep0+ll)
17947 jmopho(1,na+ll)=jmohep(1,nhep0+ll)
17948 IF (jmohep(1,nhep0+ll).EQ.ip) jmopho(1,na+ll)=1
17950 ppho(i,na+ll)=phep(i,nhep0+ll)
17958 IF(iftop) CALL
photwo(0)
17961 IF ( (abs(ppho(4,1)-ppho(5,1)).GT.ppho(5,1)*1.
e-8)
17962 + .AND.(ppho(5,1).NE.0))
THEN
17968 10 bet(j)=-ppho(j,1)/ppho(5,1)
17969 gam=ppho(4,1)/ppho(5,1)
17970 DO 30 i=jdapho(1,1),jdapho(2,1)
17971 pb=bet(1)*ppho(1,i)+bet(2)*ppho(2,i)+bet(3)*ppho(3,i)
17973 20 ppho(j,i)=ppho(j,i)+bet(j)*(ppho(4,i)+pb/(gam+1.))
17974 30 ppho(4,i)=gam*ppho(4,i)+pb
17977 pb=bet(1)*ppho(1,i)+bet(2)*ppho(2,i)+bet(3)*ppho(3,i)
17979 ppho(j,i)=ppho(j,i)+bet(j)*(ppho(4,i)+pb/(gam+1.))
17981 ppho(4,i)=gam*ppho(4,i)+pb
17984 IF(iftop) CALL
photwo(1)
18006 INTEGER iv1,iv2,iv3
18007 INTEGER phovn1,phovn2
18008 common/phover/phovn1,phovn2
18010 common/pholun/phlun
18011 LOGICAL interf,isec,iftop
18013 COMMON /phokey/ interf,fint,isec,fsec,iftop
18015 common/phocop/alpha,xphcut
18028 WRITE(phlun,10400) iv1,iv2
18030 iv2=(phovn2-iv1*10000)/100
18031 iv3=phovn2-iv1*10000-iv2*100
18032 WRITE(phlun,10500) iv1,iv2,iv3
18041 WRITE(phlun,11000) interf,isec,iftop,alpha,xphcut
18043 IF (interf)
WRITE(phlun,10700)
18044 IF (isec)
WRITE(phlun,10800)
18045 IF (iftop)
WRITE(phlun,10900)
18050 10100
FORMAT(1h ,
'*',t81,
'*')
18051 10200
FORMAT(1h ,80(
'*'))
18052 10300
FORMAT(1h ,
'*',26
x,26(
'='),t81,
'*')
18053 10400
FORMAT(1h ,
'*',28
x,
'PHOTOS, VERSION: ',i2,
'.',i2,t81,
'*')
18054 10500
FORMAT(1h ,
'*',28
x,
'RELEASED AT: ',i2,
'/',i2,
'/',i2,t81,
'*')
18055 10600
FORMAT(1h ,
'*',18
x,
'PHOTOS QED CORRECTIONS IN PARTICLE DECAYS',
18057 10700
FORMAT(1h ,
'*',18
x,
'OPTION WITH INTERFERENCE IS ACTIVE ',
18059 10800
FORMAT(1h ,
'*',18
x,
'OPTION WITH DOUBLE PHOTONS IS ACTIVE ',
18061 10900
FORMAT(1h ,
'*',18
x,
'EMISION IN T TBAR PRODUCTION IS ACTIVE ',
18063 11000
FORMAT(1h ,
'*',18
x,
'INTERNAL INPUT PARAMETERS:',t81,
'*'
18064 &,/, 1h ,
'*',t81,
'*'
18065 &,/, 1h ,
'*',18
x,
'INTERF=',l2,
' ISEC=',l2,
' IFTOP=',l2,t81,
'*'
18066 &,/, 1h ,
'*',18
x,
'ALPHA_QED=',f8.5,
' XPHCUT=',f8.5,t81,
'*')
18067 11100
FORMAT(1h ,
'*',9
x,
'MONTE CARLO PROGRAM - BY E. BARBERIO, B. VAN EI
18068 &JK AND Z. WAS',t81,
'*',/,
18069 & 1h ,
'*',9
x,
'FROM VERSION 2.0 ON - BY E.B. AND Z.W.',t81,
'*')
18168 IF (
init.NE.0)
RETURN
18185 SUBROUTINE phomak(IPPAR,NHEP0)
18206 DOUBLE PRECISION data
18208 INTEGER ip,ippar,ncharg
18209 INTEGER wtdum,idum,nhep0
18210 INTEGER ncharb,neudau
18214 parameter(nmxhep=2000)
18215 INTEGER idhep,isthep,jdahep,jmohep,nevhep,nhep
18216 DOUBLE PRECISION phep,vhep
18217 common/
hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
18218 +jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
18219 LOGICAL interf,isec,iftop
18221 COMMON /phokey/ interf,fint,isec,fsec,iftop
18228 CALL
phochk(jdahep(1,ip))
18230 CALL
phopre(1,wt,neudau,ncharb)
18231 IF (wt.EQ.0.0)
RETURN
18234 CALL
phodo(1,ncharb,neudau)
18235 IF (interf) wt=wt*
phint(idum)/fint
18245 SUBROUTINE phooma(IFIRST,ILAST,POINTR)
18267 parameter(nmxpho=2000)
18268 INTEGER idpho,istpho,jdapho,jmopho,nevpho,npho
18270 common/phoevt/nevpho,npho,istpho(nmxpho),idpho(nmxpho),
18271 &jmopho(2,nmxpho),jdapho(2,nmxpho),ppho(5,nmxpho),vpho(4,nmxpho)
18272 INTEGER ifirst,ilast,i,j,bufpoi,pointr(nmxpho)
18273 REAL bufmas,mass(nmxpho)
18274 IF (ifirst.EQ.ilast)
RETURN
18277 DO 10 i=ifirst,ilast
18278 10 mass(i)=ppho(5,pointr(i))
18281 DO 30 i=ifirst,ilast-1
18283 IF (mass(j).LE.mass(i)) goto 20
18285 pointr(j)=pointr(i)
18299 SUBROUTINE phoout(IP,BOOST,NHEP0)
18320 parameter(nmxhep=2000)
18321 INTEGER idhep,isthep,jdahep,jmohep,nevhep,nhep
18322 DOUBLE PRECISION phep,vhep
18323 common/
hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
18324 +jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
18326 parameter(nmxpho=2000)
18327 INTEGER idpho,istpho,jdapho,jmopho,nevpho,npho
18329 common/phoevt/nevpho,npho,istpho(nmxpho),idpho(nmxpho),
18330 +jmopho(2,nmxpho),jdapho(2,nmxpho),ppho(5,nmxpho),vpho(4,nmxpho)
18333 INTEGER nn,j,k,nhep0,na
18334 DOUBLE PRECISION bet(3),gam,pb
18335 COMMON /phocms/ bet,gam
18336 IF(npho.EQ.nevpho)
RETURN
18340 DO 20 j=jdapho(1,1),jdapho(2,1)
18341 pb=-bet(1)*ppho(1,j)-bet(2)*ppho(2,j)-bet(3)*ppho(3,j)
18343 10 ppho(k,j)=ppho(k,j)-bet(k)*(ppho(4,j)+pb/(gam+1.))
18344 20 ppho(4,j)=gam*ppho(4,j)+pb
18346 DO nn=nevpho+1,npho
18347 pb=-bet(1)*ppho(1,nn)-bet(2)*ppho(2,nn)-bet(3)*ppho(3,nn)
18349 30 ppho(k,nn)=ppho(k,nn)-bet(k)*(ppho(4,nn)+pb/(gam+1.))
18350 ppho(4,nn)=gam*ppho(4,nn)+pb
18357 idhep(
first+ll) = idpho(3+ll)
18359 phep(i,
first+ll) = ppho(i,3+ll)
18365 idhep(nhep0+ll) = idpho(na+ll)
18366 isthep(nhep0+ll)=istpho(na+ll)
18367 jmohep(1,nhep0+ll)=ip
18368 jmohep(2,nhep0+ll)=jmohep(2,jdahep(1,ip))
18369 jdahep(1,nhep0+ll)=0
18370 jdahep(2,nhep0+ll)=0
18372 phep(i,nhep0+ll) = ppho(i,na+ll)
18375 nhep=nhep+npho-nevpho
18382 SUBROUTINE phopre(IPARR,WT,NEUDAU,NCHARB)
18406 DOUBLE PRECISION minmas,mpasqr,mchren
18407 DOUBLE PRECISION beta,eps,del1,del2,
data
18409 INTEGER ip,iparr,ippar,i,j,me,ncharg,neupoi,nlast,thedum
18411 INTEGER ncharb,neudau
18414 parameter(nmxpho=2000)
18415 INTEGER idpho,istpho,jdapho,jmopho,nevpho,npho
18417 common/phoevt/nevpho,npho,istpho(nmxpho),idpho(nmxpho),
18418 +jmopho(2,nmxpho),jdapho(2,nmxpho),ppho(5,nmxpho),vpho(4,nmxpho)
18420 common/phoif/chkif(nmxpho)
18421 INTEGER chapoi(nmxpho)
18422 DOUBLE PRECISION mchsqr,mnesqr
18424 common/phomom/mchsqr,mnesqr,pneutr(5)
18425 DOUBLE PRECISION costhg,sinthg
18427 common/phophs/xphmax,xphoto,costhg,sinthg
18429 common/phocop/alpha,xphcut
18431 REAL probh,corwt,xf
18432 common/phopro/irep,probh,corwt,xf
18441 IF (jdapho(1,ip).EQ.0)
RETURN
18448 DO 20 i=jdapho(1,ip),jdapho(2,ip)
18452 idabs=abs(idpho(i))
18453 IF (chkif(i-jdapho(1,ip)+3))
THEN
18454 IF (
phocha(idpho(i)).NE.0)
THEN
18456 IF (ncharg.GT.nmxpho)
THEN
18462 minmas=minmas+ppho(5,i)**2
18464 massum=massum+ppho(5,i)
18466 IF (ncharg.NE.0)
THEN
18469 IF ((ppho(5,ip)-massum)/ppho(5,ip).GT.2.*xphcut)
THEN
18473 IF (ncharg.GT.1) CALL
phooma(1,ncharg,chapoi)
18477 40 pneutr(j)=-ppho(j,chapoi(ncharg))
18478 pneutr(4)=ppho(5,ip)-ppho(4,chapoi(ncharg))
18481 mpasqr=ppho(5,ip)**2
18482 mchsqr=ppho(5,chapoi(ncharg))**2
18483 IF ((jdapho(2,ip)-jdapho(1,ip)).EQ.1)
THEN
18484 neupoi=jdapho(1,ip)
18485 IF (neupoi.EQ.chapoi(ncharg)) neupoi=jdapho(2,ip)
18486 mnesqr=ppho(5,neupoi)**2
18487 pneutr(5)=ppho(5,neupoi)
18489 mnesqr=pneutr(4)**2-pneutr(1)**2-pneutr(2)**2-pneutr(3)**2
18490 mnesqr=max(mnesqr,minmas-mchsqr)
18491 pneutr(5)=
sqrt(mnesqr)
18495 xphmax=(mpasqr-(pneutr(5)+ppho(5,chapoi(ncharg)))**2)/mpasqr
18498 CALL
phoene(mpasqr,mchren,
beta,idpho(chapoi(ncharg)))
18501 IF ((xphoto.LT.xphcut).OR.(xphoto.GT.xphmax))
THEN
18506 IF (ncharg.GT.0)
THEN
18514 eps=mchren/(1.+
beta)
18517 del1=(2.-eps)*(eps/(2.-eps))**
phoran(thedum)
18519 costhg=(1.-del1)/
beta
18520 sinthg=
sqrt(del1*del2-mchren)/
beta
18523 me=2.*
phospi(idpho(chapoi(ncharg)))+1.
18528 DO i=jdapho(1,ip),jdapho(2,ip)
18529 IF (i.NE.chapoi(ncharg))
THEN
18539 ncharb=chapoi(ncharg)
18540 ncharb=ncharb-jdapho(1,ip)+3
18541 neudau=neudau-jdapho(1,ip)+3
18542 wt=
phocor(mpasqr,mchren,me)
18546 data=ppho(5,ip)-massum
18556 REAL*4 FUNCTION phoran(IDUMMY)
18557 CALL ranlux(rtim,1)
18582 common/pholun/phlun
18584 parameter(phomes=10)
18586 common/phosta/
status(phomes)
18598 IF (
status(i).EQ.0) goto 10
18599 IF ((i.EQ.6).OR.(i.EQ.10))
THEN
18600 WRITE(phlun,10500) i,
status(i)
18603 WRITE(phlun,10600) i,
status(i)
18606 IF (.NOT.error)
WRITE(phlun,10700)
18611 10100
FORMAT(1h ,80(
'*'))
18612 10200
FORMAT(1h ,
'*',t81,
'*')
18613 10300
FORMAT(1h ,
'*',26
x,25(
'='),t81,
'*')
18614 10400
FORMAT(1h ,
'*',30
x,
'PHOTOS RUN SUMMARY',t81,
'*')
18615 10500
FORMAT(1h ,
'*',22
x,
'WARNING #',i2,
' OCCURED',i6,
' TIMES',t81,
'*')
18616 10600
FORMAT(1h ,
'*',23
x,
'ERROR #',i2,
' OCCURED',i6,
' TIMES',t81,
'*')
18617 10700
FORMAT(1h ,
'*',16
x,
'PHOTOS EXECUTION HAS SUCCESSFULLY TERMINATED',
18640 DOUBLE PRECISION data
18642 INTEGER i,is1,is2,is3,is4,is5,j
18643 INTEGER iseed,i97,j97
18644 REAL uran,cran,cdran,cmran
18645 common/phseed/iseed(2),i97,j97,uran(97),cran,cdran,cmran
18648 IF ((iseed(1).LT.0).OR.(iseed(1).GE.31328))
THEN
18652 IF ((iseed(2).LT.0).OR.(iseed(2).GE.30081))
THEN
18658 is1=
mod(iseed(1)/177,177)+2
18659 is2=
mod(iseed(1),177)+2
18660 is3=
mod(iseed(2)/169,178)+1
18661 is4=
mod(iseed(2),169)
18666 is5=
mod(
mod(is1*is2,179)*is3,179)
18670 is4=
mod(53*is4+1,169)
18671 IF (
mod(is4*is5,64).GE.32)
s=
s+
t
18674 cran=362436./16777216.
18675 cdran=7654321./16777216.
18676 cmran=16777213./16777216.
18683 SUBROUTINE phoro2(ANGLE,PVEC)
18700 DOUBLE PRECISION cs,sn,
angle
18710 SUBROUTINE phoro3(ANGLE,PVEC)
18727 DOUBLE PRECISION cs,sn,
angle
18758 INTEGER idhep,idabs
18763 DATA spin/ 8*.5, 1., 0., 8*.5, 2*0., 4*1., 76*0./
18767 IF (idabs.LE.100)
THEN
18784 SUBROUTINE photos(IPARR)
18807 INTEGER ip,iparr,ippar,i,j,k,l,nlast
18808 DOUBLE PRECISION data
18809 INTEGER mother,pospho
18812 parameter(nmxhep=2000)
18813 INTEGER idhep,isthep,jdahep,jmohep,nevhep,nhep
18814 DOUBLE PRECISION phep,vhep
18815 common/
hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
18816 +jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
18818 common/phoqed/qedrad(nmxhep)
18820 parameter(nmxpho=2000)
18821 INTEGER istack(0:nmxpho),numit,ntry,kk,ll,ii,na,
first,
last
18822 INTEGER firsta,lasta,ipp,ida1,ida2,mother2,idpho,ispho
18823 REAL porig(5,nmxpho)
18832 IF ((jdahep(1,ip).EQ.0).OR.(jmohep(1,jdahep(1,ip)).NE.ip))
RETURN
18844 IF (iparr.GT.0)
THEN
18846 DO i=jdahep(1,ip),jdahep(2,ip)
18847 IF (jdahep(1,i).NE.0.AND.jmohep(1,jdahep(1,i)).EQ.i)
THEN
18849 IF (numit.GT.nmxpho)
THEN
18856 IF(numit.GT.ntry)
THEN
18865 first=jdahep(1,istack(kk))
18866 last=jdahep(2,istack(kk))
18869 porig(ll,ii)=phep(ll,
first+ii-1)
18876 IF(nhep.GT.na)
THEN
18879 firsta=jdahep(1,ipp)
18880 lasta=jdahep(2,ipp)
18881 IF(jmohep(1,ipp).EQ.istack(kk)) CALL
phobos(ipp,porig(1,ii)
18882 + ,phep(1,ipp),firsta,lasta)
18888 IF (nhep.GT.nlast)
THEN
18889 DO 100 i=nlast+1,nhep
18893 pospho=jdahep(2,mother)+1
18899 mother2 =jmohep(2,i)
18904 IF (pospho.NE.nhep)
THEN
18908 DO 60 k=i,pospho+1,-1
18909 isthep(k)=isthep(k-1)
18910 qedrad(k)=qedrad(k-1)
18911 idhep(k)=idhep(k-1)
18913 jmohep(l,k)=jmohep(l,k-1)
18914 40 jdahep(l,k)=jdahep(l,k-1)
18916 50 phep(l,k)=phep(l,k-1)
18918 60 vhep(l,k)=vhep(l,k-1)
18923 IF ((jmohep(l,k).NE.0).AND.(jmohep(l,k).GE. pospho))
18924 + jmohep(l,k)=jmohep(l,k)+1
18925 IF ((jdahep(l,k).NE.0).AND.(jdahep(l,k).GE. pospho))
18926 + jdahep(l,k)=jdahep(l,k)+1
18931 80 phep(j,pospho)=
photon(j)
18935 jdahep(2,mother)=pospho
18936 isthep(pospho)=ispho
18937 idhep(pospho)=idpho
18938 jmohep(1,pospho)=mother
18939 jmohep(2,pospho)=mother2
18940 jdahep(1,pospho)=ida1
18941 jdahep(2,pospho)=ida2
18945 90 vhep(j,pospho)=vhep(j,pospho-1)
18969 DOUBLE PRECISION da,db,dc,dapb,damb,dtrian
18976 dtrian=
sqrt((damb-dc)*(dapb+dc)*(damb+dc)*(dapb-dc))
19001 parameter(nmxpho=2000)
19002 INTEGER idpho,istpho,jdapho,jmopho,nevpho,npho
19004 common/phoevt/nevpho,npho,istpho(nmxpho),idpho(nmxpho),
19005 +jmopho(2,nmxpho),jdapho(2,nmxpho),ppho(5,nmxpho),vpho(4,nmxpho)
19006 DOUBLE PRECISION bet(3),gam
19007 COMMON /phocms/ bet,gam
19018 ifrad=(idpho(1).EQ.21).AND.(idpho(2).EQ.21)
19019 ifrad=ifrad.OR.(idpho(1).EQ.-idpho(2).AND.abs(idpho(1)).LE.6)
19020 ifrad=ifrad .AND.(abs(idpho(3)).EQ.6).AND.(abs(idpho(4)).EQ.6)
19021 mpasqr= (ppho(4,1)+ppho(4,2))**2-(ppho(3,1)+ppho(3,2))**2
19022 + -(ppho(2,1)+ppho(2,2))**2-(ppho(1,1)+ppho(1,2))**2
19023 ifrad=ifrad.AND.(mpasqr.GT.0.0)
19027 ppho(i,1)=ppho(i,1)+ppho(i,2)
19029 ppho(5,1)=
sqrt(mpasqr)
19063 parameter(nmxhep=2000)
19064 INTEGER idhep,isthep,jdahep,jmohep,nevhep,nhep
19065 DOUBLE PRECISION phep,vhep
19066 common/
hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
19067 &jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
19068 LOGICAL interf,isec,iftop
19070 COMMON /phokey/ interf,fint,isec,fsec,iftop
19078 IF (jdahep(1,id).EQ.0)
RETURN
19087 IF (rn.GE.0.5)
THEN
19103 SUBROUTINE prod5(P1,P2,P3,PIA)
19109 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
19110 COMMON / idfc / idff
19111 REAL pia(4),
p1(4),
p2(4),
p3(4)
19114 IF (ktom.EQ.1.OR.ktom.EQ.-1)
THEN
19115 sign= idff/abs(idff)
19116 ELSEIF (ktom.EQ.2)
THEN
19117 sign=-idff/abs(idff)
19119 print *,
'STOP IN PROD5: KTOM=',ktom
19125 pia(1)= -
p3(3)*det2(2,4)+
p3(4)*det2(2,3)+
p3(2)*det2(3,4)
19126 pia(2)= -
p3(4)*det2(1,3)+
p3(3)*det2(1,4)-
p3(1)*det2(3,4)
19127 pia(3)=
p3(4)*det2(1,2)-
p3(2)*det2(1,4)+
p3(1)*det2(2,4)
19128 pia(4)=
p3(3)*det2(1,2)-
p3(2)*det2(1,3)+
p3(1)*det2(2,3)
19131 10 pia(i)=pia(i)*sign
19140 SUBROUTINE pyremm(IPU1,IPU2)
19144 COMMON /leptou/ cut(14),lst(40),parl(30),xlp,ylp,w2lp,q2lp,ulp
19145 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
19146 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
19147 COMMON /pypara/ ipy(80),pypar(80),pyvar(80)
19148 COMMON /pyproc/ isub,kfl(3,2),
x(2),sh,th,uh,q2,xsec(0:40)
19149 dimension kflch(2),kflsp(2),chi(2),pms(6),is(2),robo(5)
19150 DOUBLE PRECISION dbetax,dbetaz,drobo(5)
19151 DATA ipu,iq/0,0/,pei,pe,pzi,
pz,shs,pzh,peh/7*0./
19154 IF(ipu1.EQ.0.AND.ipu2.EQ.0)
RETURN
19156 IF(ipu1.EQ.0) ilep=1
19157 IF(ipu2.EQ.0) ilep=2
19158 IF(isub.EQ.7) ilep=-1
19159 IF(ilep.EQ.1) iq=21
19160 IF(ilep.EQ.2) iq=23
19165 IF(i.EQ.3) ipu=ipu1
19166 IF(i.EQ.4) ipu=ipu2
19174 ELSEIF(ipu.NE.0)
THEN
19177 CALL
lprikt(parl(3),ptspl,phispl)
19178 p(i,1)=ptspl*
cos(phispl)
19179 p(i,2)=ptspl*
sin(phispl)
19180 pms(i-2)=
p(i,5)**2+
p(i,1)**2+
p(i,2)**2
19185 shs=(1.-
x(5-i))*q2/
x(5-i)+pyvar(7-i)**2
19190 IF(ilep.EQ.0) shs=pyvar(31)*pyvar(32)*pyvar(2)+
19191 +(
p(3,1)+
p(4,1))**2+(
p(3,2)+
p(4,2))**2
19192 shr=
sqrt(max(0.,shs))
19194 IF((shs-pms(1)-pms(2))**2-4.*pms(1)*pms(2).LE.0.) goto 10
19195 p(3,4)=0.5*(shr+(pms(1)-pms(2))/shr)
19196 p(3,3)=
sqrt(max(0.,
p(3,4)**2-pms(1)))
19199 ELSEIF(ilep.EQ.1)
THEN
19204 ELSEIF(ilep.EQ.2)
THEN
19215 drobo(3)=(
p(3,1)+
p(4,1))/shr
19216 drobo(4)=(
p(3,2)+
p(4,2))/shr
19218 CALL ludbrb(mstu(1),mstu(2),0.,0.,-drobo(3),-drobo(4),0.d0)
19221 CALL ludbrb(mstu(1),mstu(2),0.,-robo(2),0.d0,0.d0,0.d0)
19224 CALL ludbrb(mstu(1),mstu(2),-robo(1),0.,0.d0,0.d0,0.d0)
19225 mstu(2)=max(ipy(47),ipu1,ipu2)
19227 CALL ludbrb(mstu(1),mstu(2),
19228 + robo(1),robo(2),drobo(3),drobo(4),0.d0)
19229 drobo(5)=max(-0.999999,min(0.999999,(pyvar(31)-pyvar(32))/
19230 + (pyvar(31)+pyvar(32))))
19232 CALL ludbrb(mstu(1),mstu(2),0.,0.,0.d0,0.d0,drobo(5))
19240 WRITE(*,*)
'ILEP<0!!!!'
19241 IF(ipy(12).LE.0.OR.isub.EQ.7) pyvar(33)=0.
19242 IF(ipy(12).LE.0.OR.isub.EQ.7) pyvar(34)=0.
19243 peh=
p(3,4)+
p(4,4)+0.5*pyvar(1)*(pyvar(33)+pyvar(34))
19244 pzh=
p(3,3)+
p(4,3)+0.5*pyvar(1)*(pyvar(33)-pyvar(34))
19245 shh=(pyvar(1)-peh)**2-(
p(3,1)+
p(4,1))**2-(
p(3,2)+
p(4,2))**2-
19248 IF(shr.GE.pyvar(1).OR.shh.LE.(pmmin+pypar(12))**2)
THEN
19249 WRITE(*,*)
'ERROR 1 IPY(48)'
19253 shr=
sqrt(shh+(
p(3,1)+
p(4,1))**2+(
p(3,2)+
p(4,2))**2)
19259 pei=
p(iq,4)+
p(ip,4)
19260 pzi=
p(iq,3)+
p(ip,3)
19261 pms(ilep)=max(0.,pei**2-pzi**2+
p(5-ilep,1)**2+
p(5-ilep,2)**2)
19262 pmmin=
p(3-ilep,5)+
ulmass(k(5-ilep,2))+
sqrt(pms(ilep))
19267 IF(shr.LE.pmmin+pypar(12))
THEN
19277 IF(jt.EQ.ilep) goto 70
19278 IF(jt.EQ.1) ipu=ipu1
19279 IF(jt.EQ.2) ipu=ipu2
19280 CALL
pyspla(ipy(40+jt),kfl(1,jt),kflch(jt),kflsp(jt))
19291 IF(ipy(34).GE.1) k(i+1,2)=1000+jt
19294 IF(kflsp(jt).EQ.21)
THEN
19299 k(i,4)=ipu+ipu*mstu(5)
19300 k(i,5)=ipu+ipu*mstu(5)
19301 k(ipu,4)=
mod(k(ipu,4),mstu(5))+i*mstu(5)
19302 k(ipu,5)=
mod(k(ipu,5),mstu(5))+i*mstu(5)
19304 ifls=(3-isign(1,kflsp(jt)*(1102-iabs(kflsp(jt)))))/2
19308 k(ipu,6-ifls)=
mod(k(ipu,6-ifls),mstu(5))+i*mstu(5)
19310 IF(kflch(jt).EQ.0)
THEN
19313 pms(jt)=
p(i,5)**2+
p(i,1)**2+
p(i,2)**2
19317 CALL
lprikt(parl(14),ptspl,phispl)
19319 CALL
lremh(0,kflsp(jt),kflch(jt),chi(jt))
19320 p(i,1)=-
p(jt+2,1)*(1.-chi(jt))+ptspl*
cos(phispl)
19321 p(i,2)=-
p(jt+2,2)*(1.-chi(jt))+ptspl*
sin(phispl)
19322 pms(jt+2)=
p(i,5)**2+
p(i,1)**2+
p(i,2)**2
19333 p(i,1)=-
p(jt+2,1)*chi(jt)-ptspl*
cos(phispl)
19334 p(i,2)=-
p(jt+2,2)*chi(jt)-ptspl*
sin(phispl)
19335 pms(jt+4)=
p(i,5)**2+
p(i,1)**2+
p(i,2)**2
19337 pms(jt)=pms(jt+4)/chi(jt)+pms(jt+2)/(1.-chi(jt))
19341 IF(ipy(34).GE.1) k(i+1,2)=1000+jt
19342 IF((iabs(kflch(jt)).GE.1.AND.iabs(kflch(jt)).LE.8).OR.
19343 + iabs(kflch(jt)).EQ.21.OR.
lucomp(iabs(kflch(jt))).EQ.90)
THEN
19344 ifls=(3-isign(1,kflch(jt)*(1102-iabs(kflch(jt)))))/2
19349 k(ipu,6-ifls)=
mod(k(ipu,6-ifls),mstu(5))+i*mstu(5)
19351 IF(ipy(34).GE.1)
THEN
19358 IF(shr.LE.
sqrt(pms(1))+
sqrt(pms(2))) goto 40
19363 IF(jt.EQ.ilep) goto 80
19364 pe=0.5*(shr+(pms(jt)-pms(3-jt))/shr)
19366 IF(kflch(jt).EQ.0)
THEN
19368 p(is(jt),3)=
pz*(-1)**(jt-1)
19370 pw1=chi(jt)*(pe+
pz)
19371 p(is(jt)+2,4)=0.5*(pw1+pms(jt+4)/pw1)
19372 p(is(jt)+2,3)=0.5*(pw1-pms(jt+4)/pw1)*(-1)**(jt-1)
19373 p(is(jt),4)=pe-
p(is(jt)+2,4)
19374 p(is(jt),3)=
pz*(-1)**(jt-1)-
p(is(jt)+2,3)
19383 CALL ludbrb(mstu(1),mstu(2),
19384 + 0.,0.,0.d0,0.d0,-dble(pzh)/(dble(pyvar(1))-dble(peh)))
19389 imax=max(ip,ipy(47))
19391 pzf=
pz*(-1)**(ilep-1)
19392 pt2=
p(5-ilep,1)**2+
p(5-ilep,2)**2
19393 phipt=
ulangl(
p(5-ilep,1),
p(5-ilep,2))
19394 CALL ludbrb(imin,imax,0.,-phipt,0.d0,0.d0,0.d0)
19395 rqp=
p(iq,3)*(pt2+pei**2)-
p(iq,4)*pei*pzi
19396 sinth=
p(iq,4)*
sqrt(pt2*(pt2+pei**2)/(rqp**2+pt2*
19397 +
p(iq,4)**2*pzi**2))*sign(1.,-rqp)
19398 CALL ludbrb(imin,imax,asin(sinth),0.,0.d0,0.d0,0.d0)
19399 dbetax=(-dble(pei)*pzi*sinth+
19400 +
sqrt(dble(pt2)*(pt2+pei**2-(pzi*sinth)**2)))/
19401 + (dble(pt2)+pei**2)
19402 CALL ludbrb(imin,imax,0.,0.,dbetax,0.d0,0.d0)
19403 CALL ludbrb(imin,imax,0.,phipt,0.d0,0.d0,0.d0)
19404 pem=
p(iq,4)+
p(ip,4)
19405 pzm=
p(iq,3)+
p(ip,3)
19406 dbetaz=(-dble(pem)*pzm+
19407 + pzf*
sqrt(dble(pzf)**2+pem**2-pzm**2))/(dble(pzf)**2+pem**2)
19408 CALL ludbrb(imin,imax,0.,0.,0.d0,0.d0,dbetaz)
19409 CALL ludbrb(3,4,asin(sinth),0.,dbetax,0.d0,0.d0)
19410 CALL ludbrb(3,4,0.,phipt,0.d0,0.d0,dbetaz)
19420 SUBROUTINE pyspla(KPART,KFLIN,KFLCH,KFLSP)
19424 COMMON /leptou/ cut(14),lst(40),parl(30),xlp,ylp,w2lp,q2lp,ulp
19427 ksign=isign(1,kpart)
19432 IF(lst(14).EQ.0)
THEN
19435 IF(kflin.EQ.21) kflsp=21
19439 IF(iabs(kpart).EQ.211)
THEN
19444 ELSEIF(ifl.EQ.-1)
THEN
19447 ELSEIF(kflin.EQ.21)
THEN
19457 ELSEIF((ifl.GE.1.AND.ifl.LE.8).AND.ifl.NE.2)
THEN
19459 CALL
lukfdi(-iflin,2*ksign,idum,kflch)
19461 ELSEIF((ifl.GE.-8.AND.ifl.LE.-1).AND.ifl.NE.-1)
THEN
19463 CALL
lukfdi(-iflin,-1*ksign,idum,kflch)
19467 ELSEIF(iabs(kpart).EQ.2212)
THEN
19477 ELSEIF(ifl.EQ.1)
THEN
19480 ELSEIF(kflin.EQ.21)
THEN
19486 ELSEIF(
r.LT.4.)
THEN
19493 ELSEIF(ifl.GT.2)
THEN
19497 CALL
lukfdi(-iflin,2*ksign,idum,kflch)
19499 ELSEIF(
r.LT.4.)
THEN
19500 CALL
lukfdi(-iflin,2*ksign,idum,kflch)
19503 CALL
lukfdi(-iflin,1*ksign,idum,kflch)
19506 ELSEIF(ifl.LT.0)
THEN
19510 CALL
lukfdi(2101*ksign,-iflin,idum,kflch)
19512 ELSEIF(
r.LT.4.)
THEN
19513 CALL
lukfdi(2103*ksign,-iflin,idum,kflch)
19516 CALL
lukfdi(2203*ksign,-iflin,idum,kflch)
19519 IF(kflch.EQ.0) goto 10
19522 ELSEIF(iabs(kpart).EQ.2112)
THEN
19527 ELSEIF(ifl.EQ.1)
THEN
19535 ELSEIF(kflin.EQ.21)
THEN
19541 ELSEIF(
r.LT.5.)
THEN
19548 ELSEIF(ifl.GT.2)
THEN
19552 CALL
lukfdi(-iflin,2*ksign,idum,kflch)
19554 ELSEIF(
r.LT.5.)
THEN
19555 CALL
lukfdi(-iflin,1*ksign,idum,kflch)
19558 CALL
lukfdi(-iflin,1*ksign,idum,kflch)
19561 ELSEIF(ifl.LT.0)
THEN
19565 CALL
lukfdi(1103*ksign,-iflin,idum,kflch)
19567 ELSEIF(
r.LT.5.)
THEN
19568 CALL
lukfdi(2101*ksign,-iflin,idum,kflch)
19571 CALL
lukfdi(2103*ksign,-iflin,idum,kflch)
19574 IF(kflch.EQ.0) goto 20
19587 SUBROUTINE pysspb(IPU1,IPU2)
19591 common/foreficass/ievt
19597 COMMON /leptou/ cut(14),lst(40),parl(30),xlp,ylp,w2lp,q2lp,ulp
19598 common/lujets/
n,k(4000,5),
p(4000,5),v(4000,5)
19599 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
19600 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
19601 COMMON /pypara/ ipy(80),pypar(80),pyvar(80)
19602 COMMON /pyproc/ isub,kfl(3,2),
x(2),sh,th,uh,q2,xsec(0:40)
19603 COMMON /pyint1/ xq(2,-6:6)
19604 dimension ifls(4),is(2),xs(2),zs(2),q2s(2),tevs(2),robo(5),
19605 +xfs(2,-6:6),xfa(-6:6),xfb(-6:6),wtap(-6:6),wtsf(-6:6)
19606 DOUBLE PRECISION dq2(3),dsh,dshz,dshr,dplcm,dpc(3),dpd(4),dms,
19607 +dmsma,dpt2,dpb(4),dbe1(4),dbe2(4),dbep,dgabep,dpq(4),dpqs(2),
19608 +dm2,dq2b,drobo(5),dbez
19610 DATA ifla,nq/0,0/,
z,xe0,xa/3*0./,dshz,dmsma,dpt2,dshr/4*0.d0/
19614 IF(ipu1.EQ.0) ilep=1
19615 IF(ipu2.EQ.0) ilep=2
19618 IF(isub.EQ.27) q2e=pmas(23,1)**2
19619 IF(isub.EQ.28) q2e=pmas(24,1)**2
19620 tmax=alog(pypar(26)*pypar(27)*q2e/pypar(21)**2)
19623 IF(
n.GE.27) sh=
p(27,5)**2
19626 q2e=max(pypar(21)**2,min(q2e,(0.95/
x(3-ilep)-1.)*q2-sh,
19628 tmax=alog(q2e/pypar(21)**2)
19630 IF(pypar(26)*q2e.LT.max(pypar(22),2.*pypar(21)**2).OR.
19631 +tmax.LT.0.2)
RETURN
19632 IF(ilep.EQ.0) xe0=2.*pypar(23)/pyvar(1)
19633 b0=(33.-2.*ipy(8))/6.
19639 IF(ilep.EQ.2) nq=ipu1+2
19640 dpqs(1)=dble(
p(nq,3))
19641 dpqs(2)=dble(
p(nq,4))
19642 xbmin=
x(3-ilep)*max(0.5,sh/q2)
19643 CALL
pystfu(ipy(43-ilep),xbmin,q2,xfb)
19645 20 xq(3-ilep,ifl)=xfb(ifl)
19649 IF(kfl(2,jt).EQ.21) ifls(jt)=0
19650 ifls(jt+2)=ifls(jt)
19653 IF(ilep.EQ.0) q2s(jt)=pypar(26)*q2e
19656 30 xfs(jt,ifl)=xq(jt,ifl)
19658 q2s(ilep)=
p(nq,5)**2
19659 dq2(ilep)=q2s(ilep)
19668 IF(
n.GT.mstu(4)-10)
THEN
19669 WRITE(6,*)
' PYSSPB: NO MORE MEMORY IN LUJETS'
19680 IF((
n.GT.
ns+2.AND.q2s(2).GT.q2s(1).AND.ilep.EQ.0).OR.ilep.EQ.1)
19685 IF(ilep.GE.1.AND.
n.EQ.
ns+2) xb=xs(jt)*max(sh/q2,0.5)
19687 60 xfb(ifl)=xfs(jt,ifl)
19690 IF(ipy(14).GE.9.AND.
n.GT.
ns+4)
THEN
19691 q2b=0.5*(1./zs(jt)+1.)*q2s(jt)+0.5*(1./zs(jt)-1.)*(q2s(3-jt)-
19692 + sngl(dsh)+
sqrt((sngl(dsh)+q2s(1)+q2s(2))**2+8.*q2s(1)*q2s(2)*
19693 + zs(jt)/(1.-zs(jt))))
19694 tevb=alog(pypar(27)*q2b/pypar(21)**2)
19698 dshz=dsh/dble(zs(jt))
19699 ELSEIF(ilep.GE.1)
THEN
19701 IF(
n.GT.
ns+4) dshz=(dsh+dq2(jr)-dq2(jt))/zs(jt)-dq2(jr)+
19703 dpd(2)=dshz+dq2(jr)+dble(pypar(22))
19705 qmass=
ulmass(iabs(iflb))
19706 IF(iabs(iflb).EQ.0) qmass=
ulmass(21)
19708 IF(dq2(jr).LT.4.*qmass**2)
THEN
19710 dpc(1)=dq2(jr)*(dble(pypar(22))+dm2)**2
19711 dpc(2)=dpd(2)*(dpd(2)-2d0*pypar(22))*(pypar(22)+dm2)
19712 dpc(3)=pypar(22)*(dpd(2)-2d0*pypar(22))**2
19713 xe0=1d0-(dpc(2)-dsqrt(dpc(2)**2-4d0*dpc(1)*dpc(3)))/
19716 xe0=1d0-(dpd(2)-2d0*dble(pypar(22)))*(dpd(2)-dsqrt(dpd(2)**2-
19717 + 4d0*dq2(jr)*dble(pypar(22))))/(2d0*dq2(jr)*dble(pypar(22)))
19720 70 xe=max(xe0,xb*(1./(1.-pypar(24))-1.))
19721 IF(xb+xe.GE.0.999)
THEN
19731 wtapq=16.*(1.-
sqrt(xb+xe))/(3.*
sqrt(xb))
19732 DO 90 ifl=-ipy(8),ipy(8)
19733 IF(ifl.EQ.0) wtap(ifl)=6.*alog((1.-xb)/xe)
19734 90
IF(ifl.NE.0) wtap(ifl)=wtapq
19736 wtap(0)=0.5*xb*(1./(xb+xe)-1.)
19737 wtap(iflb)=8.*alog((1.-xb)*(xb+xe)/xe)/3.
19741 DO 110 ifl=-ipy(8),ipy(8)
19742 wtsf(ifl)=xfb(ifl)/max(1
e-10,xfb(iflb))
19743 110 wtsum=wtsum+wtap(ifl)*wtsf(ifl)
19744 IF(iabs(iflb).GE.4.AND.wtsum.GT.1e3)
THEN
19746 DO 120 ifl=-ipy(8),ipy(8)
19747 120 wtsf(ifl)=wtsf(ifl)*1e3/wtsum
19753 130
IF(ipy(14).LE.6.OR.ipy(14).GE.9)
THEN
19754 tevxp=b0/max(0.0001,wtsum)
19756 tevxp=b0/max(0.0001,5.*wtsum)
19758 tevb=tevb*
exp(max(-100.,alog(
rlu(0))*tevxp))
19759 q2ref=pypar(21)**2*
exp(tevb)/pypar(27)
19760 q2b=q2ref/pypar(27)
19764 IF(
n.GT.
ns+4) dshz=(dsh+dq2(jr)-dq2(jt))/dble(zs(jt))-dq2(jr)+
19767 IF(q2b.LT.pypar(22))
THEN
19773 wtran=wtran-wtap(ifla)*wtsf(ifla)
19774 IF(ifla.LT.ipy(8).AND.wtran.GT.0.) goto 140
19777 IF(iflb.EQ.0.AND.ifla.EQ.0)
THEN
19778 z=1./(1.+((1.-xb)/xb)*(xe/(1.-xb))**
rlu(0))
19779 wtz=(1.-
z*(1.-
z))**2
19780 ELSEIF(iflb.EQ.0)
THEN
19781 z=xb/(1.-
rlu(0)*(1.-
sqrt(xb+xe)))**2
19782 wtz=0.5*(1.+(1.-
z)**2)*
sqrt(
z)
19783 ELSEIF(ifla.EQ.0)
THEN
19784 z=xb*(1.+
rlu(0)*(1./(xb+xe)-1.))
19787 z=1.-(1.-xb)*(xe/((xb+xe)*(1.-xb)))**
rlu(0)
19792 IF(ilep.GE.1.AND.
n.EQ.
ns+2)
THEN
19793 xbnew=
x(jt)*(1.+(dsh-q2b)/dq2(jr))
19794 IF(xbnew.GT.min(
z,0.999)) goto 130
19799 IF(ipy(15).GE.1)
THEN
19801 IF(iflb.NE.0) rsoft=8./3.
19802 z=
z*(tevb/tevs(jt))**(rsoft*xe/((xb+xe)*b0))
19803 IF(
z.LE.xb) goto 130
19808 IF(ilep.GE.1.AND.iabs(iflb).GE.4.AND.(xfb(iflb).LT.1
e-10.OR.
19809 + q2b.LT.5.*
ulmass(iabs(iflb))**2))
THEN
19816 dpd(2)=dshz+dq2(jr)+dq2b
19817 dm2=
ulmass(iabs(ifla-iflb))**2
19818 IF(iabs(ifla-iflb).EQ.0) dm2=
ulmass(21)**2
19819 dpc(1)=dq2(jr)*(dq2b+dm2)**2
19820 dpc(2)=dpd(2)*(dpd(2)-2d0*dq2b)*(dq2b+dm2)
19821 dpc(3)=dq2b*(dpd(2)-2d0*dq2b)**2
19822 zu=(dpc(2)-dsqrt(dpc(2)**2-4d0*dpc(1)*dpc(3)))/(2d0*dpc(1))
19823 IF(
z.GE.zu) goto 130
19827 IF(ipy(14).GE.5.AND.ipy(14).LE.6.AND.
n.LE.
ns+4)
THEN
19829 IF(q2b/(1.-
z).GT.pypar(26)*q2) goto 130
19830 ELSEIF(ipy(14).GE.3.AND.ipy(14).LE.6.AND.
n.GE.
ns+6)
THEN
19832 q2max=0.5*(1./zs(jt)+1.)*dq2(jt)+0.5*(1./zs(jt)-1.)*
19833 + (dq2(3-jt)-dsh+
sqrt((dsh+dq2(1)+dq2(2))**2+8.*dq2(1)*dq2(2)*
19834 + zs(jt)/(1.-zs(jt))))
19835 IF(q2b/(1.-
z).GE.q2max) goto 130
19837 ELSEIF(ipy(14).EQ.7.OR.ipy(14).EQ.8)
THEN
19839 IF((1.-
z)*q2b.LT.pypar(22)) goto 130
19840 alprat=tevb/(tevb+alog(1.-
z))
19841 IF(alprat.LT.5.*
rlu(0)) goto 130
19842 IF(alprat.GT.5.) wtz=wtz*alprat/5.
19846 CALL
pystfu(ipy(40+jt),xb,q2ref,xfb)
19848 CALL
pystfu(ipy(40+jt),xa,q2ref,xfa)
19849 IF(ihft.EQ.1.OR.ihfx.EQ.1)
THEN
19850 IF(xfa(ifla).LT.1
e-10) ihfc=1
19852 ELSEIF(xfb(iflb).LT.1
e-20)
THEN
19855 IF(wtz*xfa(ifla)/xfb(iflb).LT.
rlu(0)*wtsf(ifla))
THEN
19856 IF(ilep.GE.1.AND.
n.EQ.
ns+2) goto 70
19861 150
IF(
n.EQ.
ns+4-2*min(1,ilep))
THEN
19864 IF(ipy(14).GE.3.AND.ipy(14).LE.6) dq2(jt)=q2b/(1.-
z)
19866 dplcm=dsqrt((dsh+dq2(1)+dq2(2))**2-4.*dq2(1)*dq2(2))/dshr
19872 IF(ifls(jr+2).EQ.0) k(i,2)=21
19878 p(i,3)=dplcm*(-1)**(jr+1)
19879 p(i,4)=(dsh+dq2(3-jr)-dq2(jr))/dshr
19880 p(i,5)=-
sqrt(sngl(dq2(jr)))
19882 k(i+1,2)=k(ipo+1,2)
19893 k(ipo,4)=
mod(k(ipo,4),mstu(5))+i*mstu(5)
19894 k(ipo,5)=
mod(k(ipo,5),mstu(5))+i*mstu(5)
19900 DO 170 itemp=
ns+1,
ns+4
19905 180
p(i1,j)=
p(nq,j)
19918 k(i1,2)=kfl(2,ilep)
19919 k(i2,2)=kfl(2,3-ilep)
19920 dpd(1)=dsh+dq2(1)+dq2(2)
19921 dpd(3)=(3-2*ilep)*dsqrt(dpd(1)**2-4d0*dq2(1)*dq2(2))
19922 p(i2,3)=(dpqs(2)*dpd(3)-dpqs(1)*dpd(1))/
19924 p(i2,4)=(dpqs(1)*dpd(3)-dpqs(2)*dpd(1))/
19926 p(i2,5)=-
sqrt(sngl(dq2(3-ilep)))
19927 p(i2+1,3)=max(ipu1,ipu2)
19928 p(i2+1,4)=max(ipu1,ipu2)
19929 k(i2,4)=k(i2,4)-
mod(k(i2,4),mstu(5))+max(ipu1,ipu2)
19930 k(i2,5)=k(i2,5)-
mod(k(i2,5),mstu(5))+max(ipu1,ipu2)
19933 k(25-2*ilep,4)=
mod(k(25-2*ilep,4),mstu(5))+i2*mstu(5)
19934 k(25-2*ilep,5)=
mod(k(25-2*ilep,5),mstu(5))+i2*mstu(5)
19938 ELSEIF(
n.GT.
ns+4)
THEN
19941 IF(ipy(14).GE.3.AND.ipy(14).LE.6) dq2(3)=q2b/(1.-
z)
19942 IF(is(1).GE.1.AND.is(1).LE.mstu(4))
THEN
19944 dpc(3)=0.5*(abs(
p(is(1),3))+abs(
p(is(2),3)))
19948 dpc(3)=0.5*( 0. +abs(
p(is(2),3)))
19951 dpd(1)=dsh+dq2(jr)+dq2(jt)
19952 dpd(2)=dshz+dq2(jr)+dq2(3)
19953 dpd(3)=dsqrt(dpd(1)**2-4.*dq2(jr)*dq2(jt))
19954 dpd(4)=dsqrt(dpd(2)**2-4.*dq2(jr)*dq2(3))
19956 IF((q2s(jr).GE.0.5*pypar(22).AND.dpd(1)-dpd(3).GE.1
d-10*dpd(1))
19957 + .OR.ilep.GE.1) ikin=1
19958 IF(ikin.EQ.0) dmsma=(dq2(jt)/dble(zs(jt))-dq2(3))*(dsh/
19959 + (dsh+dq2(jt))-dsh/(dshz+dq2(3)))
19960 IF(ikin.EQ.1) dmsma=(dpd(1)*dpd(2)-dpd(3)*dpd(4))/(2.*
19961 + dq2(jr))-dq2(jt)-dq2(3)
19966 k(it,2)=iflb-ifls(jt+2)
19967 IF(iflb-ifls(jt+2).EQ.0) k(it,2)=21
19969 IF(sngl(dmsma).LE.
p(it,5)**2) goto 10
19975 k(it+1,2)=k(is(jt)+1,2)
19977 IF(
mod(ipy(14),2).EQ.0)
THEN
19979 IF(ilep.EQ.0)
p(it,4)=(dshz-dsh-
p(it,5)**2)/dshr
19980 IF(ilep.GE.1)
p(it,4)=0.5*(
p(is(jt),3)*dpd(2)+
19981 + dpqs(1)*(dq2(jt)+dq2(3)+
p(it,5)**2))/(
p(is(jt),3)*dpqs(2)-
19982 +
p(is(jt),4)*dpqs(1))-dpc(jt)
19983 p(it,3)=
sqrt(max(0.,
p(it,4)**2-
p(it,5)**2))
19984 CALL
lushow(it,0,
sqrt(min(sngl(dmsma),pypar(25)*q2)))
19985 IF(
n.GE.it+2)
p(it,5)=
p(it+2,5)
19986 IF(
n.GT.mstu(4)-10)
THEN
19987 WRITE(6,*)
' PYSSPB: NO MORE MEMORY IN LUJETS'
19999 IF(ikin.EQ.0.AND.ilep.EQ.0) dpt2=(dmsma-dms)*(dshz+dq2(3))/
20001 IF(ikin.EQ.1.AND.ilep.EQ.0) dpt2=(dmsma-dms)*(0.5*dpd(1)*
20002 + dpd(2)+0.5*dpd(3)*dpd(4)-dq2(jr)*(dq2(jt)+dq2(3)+dms))/
20003 + (4.*dsh*dpc(3)**2)
20004 IF(ikin.EQ.1.AND.ilep.GE.1) dpt2=(dmsma-dms)*(0.5*dpd(1)*
20005 + dpd(2)+0.5*dpd(3)*dpd(4)-dq2(jr)*(dq2(jt)+dq2(3)+dms))/
20007 IF(dpt2.LT.0.) goto 10
20009 p(it,1)=
sqrt(sngl(dpt2))
20011 dpb(1)=(0.5*dpd(2)-dpc(jr)*(dshz+dq2(jr)-dq2(jt)-dms)/
20012 + dshr)/dpc(3)-dpc(3)
20013 p(it,3)=dpb(1)*(-1)**(jt+1)
20014 p(it,4)=(dshz-dsh-dms)/dshr
20016 dpc(3)=dq2(jt)+dq2(3)+dms
20017 dpb(2)=dpqs(2)*dble(
p(is(jt),3))-dpqs(1)*dpc(jt)
20018 dpb(1)=0.5d0*(dpc(jt)*dpd(2)+dpqs(2)*dpc(3))/dpb(2)-
20019 + dble(
p(is(jt),3))
20021 p(it,4)=0.5d0*(dble(
p(is(jt),3))*dpd(2)+
20022 + dpqs(1)*dpc(3))/dpb(2)-dpc(jt)
20026 dpb(1)=dsqrt(dpb(1)**2+dpt2)
20027 dpb(2)=dsqrt(dpb(1)**2+dms)
20029 dpb(4)=dsqrt(dpb(3)**2+dms)
20030 dbez=(dpb(4)*dpb(1)-dpb(3)*dpb(2))/(dpb(4)*dpb(2)-dpb(3)*
20032 CALL ludbrb(mstu(1),mstu(2),0.,0.,0.d0,0.d0,dbez)
20034 CALL ludbrb(mstu(1),mstu(2),the,0.,0.d0,0.d0,0.d0)
20040 IF(iflb.EQ.0) k(
n+1,2)=21
20044 p(
n+1,3)=
p(it,3)+
p(is(jt),3)
20045 p(
n+1,4)=
p(it,4)+
p(is(jt),4)
20046 p(
n+1,5)=-
sqrt(sngl(dq2(3)))
20051 k(
n+2,2)=k(is(jt)+1,2)
20058 kn1=isign(500+iabs(k(
n+1,2)),2*k(
n+1,2)+1)
20059 kd1=isign(500+iabs(k(id1,2)),2*k(id1,2)+1)
20060 IF(k(
n+1,2).EQ.21) kn1=500
20061 IF(k(id1,2).EQ.21) kd1=500
20062 IF((kn1.GE.501.AND.kd1.GE.501).OR.(kn1.LT.0.AND.
20063 + kd1.EQ.500).OR.(kn1.EQ.500.AND.kd1.EQ.500.AND.
20064 +
rlu(0).GT.0.5).OR.(kn1.EQ.500.AND.kd1.LT.0))
20073 k(
n+1,4)=k(
n+1,4)-
mod(k(
n+1,4),mstu(5))+id1
20074 k(
n+1,5)=k(
n+1,5)-
mod(k(
n+1,5),mstu(5))+id2
20075 k(id1,4)=
mod(k(id1,4),mstu(5))+(
n+1)*mstu(5)
20076 k(id1,5)=
mod(k(id1,5),mstu(5))+id2*mstu(5)
20077 k(id2,4)=
mod(k(id2,4),mstu(5))+id1*mstu(5)
20078 k(id2,5)=
mod(k(id2,5),mstu(5))+(
n+1)*mstu(5)
20085 CALL ludbrb(mstu(1),mstu(2),0.,0.,
20086 + -dble(
p(
n-1,1)+
p(is(jr),1))/dble(
p(
n-1,4)+
p(is(jr),4)),
20087 + 0.d0,-dble(
p(
n-1,3)+
p(is(jr),3))/dble(
p(
n-1,4)+
p(is(jr),4)))
20088 ir=
n-1+(jt-1)*(is(1)-
n+1)
20089 CALL ludbrb(mstu(1),mstu(2),
20090 + -
ulangl(
p(ir,3),
p(ir,1)),paru(2)*
rlu(0),0.d0,0.d0,0.d0)
20095 dbe1(4)=dpq(4)+dble(
p(
n-1,4))
20097 230 dbe1(j)=-(dpq(j)+dble(
p(
n-1,j)))/dbe1(4)
20098 dbe1(4)=1d0/dsqrt(1d0-dbe1(1)**2-dbe1(3)**2)
20099 dbep=dbe1(1)*dpq(1)+dbe1(3)*dpq(3)
20100 dgabep=dbe1(4)*(dbe1(4)*dbep/(1d0+dbe1(4))+dpq(4))
20102 240 dpq(j)=dpq(j)+dgabep*dbe1(j)
20103 dpq(4)=dbe1(4)*(dpq(4)+dbep)
20104 dpc(1)=dsqrt(dpq(1)**2+dpq(3)**2)
20105 dbe2(4)=-(dpq(4)*dpc(1)-dpqs(2)*dsqrt(dpqs(2)**2+dpc(1)**2-
20106 + dpq(4)**2))/(dpc(1)**2+dpqs(2)**2)
20107 the=
ulangl(sngl(dpq(3)),sngl(dpq(1)))
20108 dbe2(1)=dbe2(4)*dsin(dble(the))
20109 dbe2(3)=dbe2(4)*dcos(dble(the))
20110 dbe2(4)=1d0/(1d0-dbe2(1)**2-dbe2(3)*2)
20113 dpb(1)=dbe1(4)**2*dbe2(4)/(1d0+dbe1(4))
20114 dpb(2)=dbe1(1)*dbe2(1)+dbe1(3)*dbe2(3)
20115 dpb(3)=dbe1(4)*dbe2(4)*(1d0+dpb(2))
20117 250 drobo(jb+2)=(dbe1(4)*dbe2(4)*dbe1(jb)+dbe2(4)*dbe2(jb)+
20118 + dpb(1)*dbe1(jb)*dpb(2))/dpb(3)
20119 CALL ludbrb(mstu(1),mstu(2),0.,0.,drobo(3),0.d0,drobo(5))
20122 CALL ludbrb(mstu(1),mstu(2),-the,paru(2)*
rlu(0),0d0,0d0,0d0)
20129 IF(ilep.EQ.2.AND.
n.EQ.
ns+4) is(jt)=
n-3
20132 IF(ipy(14).GE.3.AND.ipy(14).LE.6) dq2(jt)=q2b/(1.-
z)
20134 IF(q2b.GE.0.5*pypar(22))
THEN
20135 ifls(jt+2)=ifls(jt)
20140 260 xfs(jt,ifl)=xfa(ifl)
20143 IF(jt.EQ.1) ipu1=
n-1
20144 IF(jt.EQ.2) ipu2=
n-1
20146 IF(max(iabs(1-ilep)*q2s(1),min(1,2-ilep)*q2s(2)).GE.0.5*pypar(22)
20147 +.OR.
n.LE.
ns+2) goto 40
20151 270 drobo(j+2)=(
p(
ns+1,j)+
p(
ns+3,j))/(
p(
ns+1,4)+
p(
ns+3,4))
20153 280
p(
n+2,j)=
p(
ns+1,j)
20156 CALL ludbrb(
n+2,
n+2,0.,0.,-drobo(3),-drobo(4),-drobo(5))
20161 CALL ludbrb(4,
ns,robo(1),robo(2),drobo(3),drobo(4),drobo(5))
20168 IF(ilep.NE.0) k(21,1)=11
20174 IF(ifls(jt).EQ.0) kfl(1,jt)=21
20175 290 pyvar(30+jt)=xs(jt)
20189 SUBROUTINE pystfu(KF,X,Q2,XPQ)
20196 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
20197 COMMON /leptou/ cut(14),lst(40),parl(30),xlp,ylp,w2lp,q2lp,ulp
20199 dimension xpq(-6:6),xppr(-6:6)
20200 DOUBLE PRECISION xx,qq,upv,dnv,sea,str,chm,bot,top,glu,
20201 +xpdf(-6:6),xpdg(0:5),val(20)
20202 CHARACTER*20 parm(20)
20203 DATA npdf/0/,upv,dnv,sea,str,chm,bot,top,glu/8*0.d0/
20210 IF(
x.LE.0..OR.
x.GE.1.)
THEN
20211 WRITE(mstu(11),10000)
x
20215 IF(kfa.NE.2112.AND.kfa.NE.2212)
THEN
20216 WRITE(mstu(11),10100) kf
20222 IF(lst(15).LT.0) mstp57=0
20223 mstp51=iabs(lst(15))
20230 IF(mstp52.EQ.1.AND.mstp51.GE.1.AND.mstp51.LE.10)
THEN
20233 20 xpq(kfl)=xppr(kfl)
20234 ELSEIF(mstp52.EQ.2)
THEN
20237 qq=
sqrt(max(0.,q2))
20257 ELSEIF(mstp52.EQ.3)
THEN
20259 iparc=(mstp51+50)/100
20260 isetc=mstp51-100*iparc
20266 30 xpq(kfl)=xpdf(kfl)
20268 WRITE(mstu(11),10200) kf,mstp52,mstp51
20272 IF(kfa.EQ.2112)
THEN
20292 xpq(kfl)=max(0.,xpq(kfl))
20293 50
IF(iabs(kfl).GT.mstp58) xpq(kfl)=0.
20296 10000
FORMAT(
' ERROR: X VALUE OUTSIDE PHYSICAL RANGE; X =',1
p,e12.3)
20297 10100
FORMAT(
' ERROR: ILLEGAL PARTICLE CODE FOR STRUCTURE FUNCTION;',
20299 10200
FORMAT(
' ERROR: UNKNOWN STRUCTURE FUNCTION; KF, LIBRARY, SET =',
20310 SUBROUTINE pystpr(X,Q2,XPPR)
20315 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
20316 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
20317 COMMON /leptou/ cut(14),lst(40),parl(30),xlp,ylp,w2lp,q2lp,ulp
20318 SAVE /ludat1/,/ludat2/
20319 dimension xppr(-6:6),xq(9),
tx(6),
tt(6),ts(6),nehlq(8,2),
20320 +cehlq(6,6,2,8,2),cdo(3,6,5,2),cmt(0:3,0:2,9,4),exmt(0:3)
20327 DATA nehlq/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/
20329 DATA (((cehlq(ix,it,nx,1,1),ix=1,6),it=1,6),nx=1,2)/
20330 + 7.677
e-01,-2.087
e-01,-3.303
e-01,-2.517
e-02,-1.570
e-02,-1.000
e-04,
20331 +-5.326
e-01,-2.661
e-01, 3.201
e-01, 1.192
e-01, 2.434
e-02, 7.620
e-03,
20332 + 2.162
e-01, 1.881
e-01,-8.375
e-02,-6.515
e-02,-1.743
e-02,-5.040
e-03,
20333 +-9.211
e-02,-9.952
e-02, 1.373
e-02, 2.506
e-02, 8.770
e-03, 2.550
e-03,
20334 + 3.670
e-02, 4.409
e-02, 9.600
e-04,-7.960
e-03,-3.420
e-03,-1.050
e-03,
20335 +-1.549
e-02,-2.026
e-02,-3.060
e-03, 2.220
e-03, 1.240
e-03, 4.100
e-04,
20336 + 2.395
e-01, 2.905
e-01, 9.778
e-02, 2.149
e-02, 3.440
e-03, 5.000
e-04,
20337 + 1.751
e-02,-6.090
e-03,-2.687
e-02,-1.916
e-02,-7.970
e-03,-2.750
e-03,
20338 +-5.760
e-03,-5.040
e-03, 1.080
e-03, 2.490
e-03, 1.530
e-03, 7.500
e-04,
20339 + 1.740
e-03, 1.960
e-03, 3.000
e-04,-3.400
e-04,-2.900
e-04,-1.800
e-04,
20340 +-5.300
e-04,-6.400
e-04,-1.700
e-04, 4.000
e-05, 6.000
e-05, 4.000
e-05,
20341 + 1.700
e-04, 2.200
e-04, 8.000
e-05, 1.000
e-05,-1.000
e-05,-1.000
e-05/
20342 DATA (((cehlq(ix,it,nx,1,2),ix=1,6),it=1,6),nx=1,2)/
20343 + 7.237
e-01,-2.189
e-01,-2.995
e-01,-1.909
e-02,-1.477
e-02, 2.500
e-04,
20344 +-5.314
e-01,-2.425
e-01, 3.283
e-01, 1.119
e-01, 2.223
e-02, 7.070
e-03,
20345 + 2.289
e-01, 1.890
e-01,-9.859
e-02,-6.900
e-02,-1.747
e-02,-5.080
e-03,
20346 +-1.041
e-01,-1.084
e-01, 2.108
e-02, 2.975
e-02, 9.830
e-03, 2.830
e-03,
20347 + 4.394
e-02, 5.116
e-02,-1.410
e-03,-1.055
e-02,-4.230
e-03,-1.270
e-03,
20348 +-1.991
e-02,-2.539
e-02,-2.780
e-03, 3.430
e-03, 1.720
e-03, 5.500
e-04,
20349 + 2.410
e-01, 2.884
e-01, 9.369
e-02, 1.900
e-02, 2.530
e-03, 2.400
e-04,
20350 + 1.765
e-02,-9.220
e-03,-3.037
e-02,-2.085
e-02,-8.440
e-03,-2.810
e-03,
20351 +-6.450
e-03,-5.260
e-03, 1.720
e-03, 3.110
e-03, 1.830
e-03, 8.700
e-04,
20352 + 2.120
e-03, 2.320
e-03, 2.600
e-04,-4.900
e-04,-3.900
e-04,-2.300
e-04,
20353 +-6.900
e-04,-8.200
e-04,-2.000
e-04, 7.000
e-05, 9.000
e-05, 6.000
e-05,
20354 + 2.400
e-04, 3.100
e-04, 1.100
e-04, 0.000
e+00,-2.000
e-05,-2.000
e-05/
20356 DATA (((cehlq(ix,it,nx,2,1),ix=1,6),it=1,6),nx=1,2)/
20357 + 3.813
e-01,-8.090
e-02,-1.634
e-01,-2.185
e-02,-8.430
e-03,-6.200
e-04,
20358 +-2.948
e-01,-1.435
e-01, 1.665
e-01, 6.638
e-02, 1.473
e-02, 4.080
e-03,
20359 + 1.252
e-01, 1.042
e-01,-4.722
e-02,-3.683
e-02,-1.038
e-02,-2.860
e-03,
20360 +-5.478
e-02,-5.678
e-02, 8.900
e-03, 1.484
e-02, 5.340
e-03, 1.520
e-03,
20361 + 2.220
e-02, 2.567
e-02,-3.000
e-05,-4.970
e-03,-2.160
e-03,-6.500
e-04,
20362 +-9.530
e-03,-1.204
e-02,-1.510
e-03, 1.510
e-03, 8.300
e-04, 2.700
e-04,
20363 + 1.261
e-01, 1.354
e-01, 3.958
e-02, 8.240
e-03, 1.660
e-03, 4.500
e-04,
20364 + 3.890
e-03,-1.159
e-02,-1.625
e-02,-9.610
e-03,-3.710
e-03,-1.260
e-03,
20365 +-1.910
e-03,-5.600
e-04, 1.590
e-03, 1.590
e-03, 8.400
e-04, 3.900
e-04,
20366 + 6.400
e-04, 4.900
e-04,-1.500
e-04,-2.900
e-04,-1.800
e-04,-1.000
e-04,
20367 +-2.000
e-04,-1.900
e-04, 0.000
e+00, 6.000
e-05, 4.000
e-05, 3.000
e-05,
20368 + 7.000
e-05, 8.000
e-05, 2.000
e-05,-1.000
e-05,-1.000
e-05,-1.000
e-05/
20369 DATA (((cehlq(ix,it,nx,2,2),ix=1,6),it=1,6),nx=1,2)/
20370 + 3.578
e-01,-8.622
e-02,-1.480
e-01,-1.840
e-02,-7.820
e-03,-4.500
e-04,
20371 +-2.925
e-01,-1.304
e-01, 1.696
e-01, 6.243
e-02, 1.353
e-02, 3.750
e-03,
20372 + 1.318
e-01, 1.041
e-01,-5.486
e-02,-3.872
e-02,-1.038
e-02,-2.850
e-03,
20373 +-6.162
e-02,-6.143
e-02, 1.303
e-02, 1.740
e-02, 5.940
e-03, 1.670
e-03,
20374 + 2.643
e-02, 2.957
e-02,-1.490
e-03,-6.450
e-03,-2.630
e-03,-7.700
e-04,
20375 +-1.218
e-02,-1.497
e-02,-1.260
e-03, 2.240
e-03, 1.120
e-03, 3.500
e-04,
20376 + 1.263
e-01, 1.334
e-01, 3.732
e-02, 7.070
e-03, 1.260
e-03, 3.400
e-04,
20377 + 3.660
e-03,-1.357
e-02,-1.795
e-02,-1.031
e-02,-3.880
e-03,-1.280
e-03,
20378 +-2.100
e-03,-3.600
e-04, 2.050
e-03, 1.920
e-03, 9.800
e-04, 4.400
e-04,
20379 + 7.700
e-04, 5.400
e-04,-2.400
e-04,-3.900
e-04,-2.400
e-04,-1.300
e-04,
20380 +-2.600
e-04,-2.300
e-04, 2.000
e-05, 9.000
e-05, 6.000
e-05, 4.000
e-05,
20381 + 9.000
e-05, 1.000
e-04, 2.000
e-05,-2.000
e-05,-2.000
e-05,-1.000
e-05/
20383 DATA (((cehlq(ix,it,nx,3,1),ix=1,6),it=1,6),nx=1,2)/
20384 + 6.870
e-02,-6.861
e-02, 2.973
e-02,-5.400
e-03, 3.780
e-03,-9.700
e-04,
20385 +-1.802
e-02, 1.400
e-04, 6.490
e-03,-8.540
e-03, 1.220
e-03,-1.750
e-03,
20386 +-4.650
e-03, 1.480
e-03,-5.930
e-03, 6.000
e-04,-1.030
e-03,-8.000
e-05,
20387 + 6.440
e-03, 2.570
e-03, 2.830
e-03, 1.150
e-03, 7.100
e-04, 3.300
e-04,
20388 +-3.930
e-03,-2.540
e-03,-1.160
e-03,-7.700
e-04,-3.600
e-04,-1.900
e-04,
20389 + 2.340
e-03, 1.930
e-03, 5.300
e-04, 3.700
e-04, 1.600
e-04, 9.000
e-05,
20390 + 1.014
e+00,-1.106
e+00, 3.374
e-01,-7.444
e-02, 8.850
e-03,-8.700
e-04,
20391 + 9.233
e-01,-1.285
e+00, 4.475
e-01,-9.786
e-02, 1.419
e-02,-1.120
e-03,
20392 + 4.888
e-02,-1.271
e-01, 8.606
e-02,-2.608
e-02, 4.780
e-03,-6.000
e-04,
20393 +-2.691
e-02, 4.887
e-02,-1.771
e-02, 1.620
e-03, 2.500
e-04,-6.000
e-05,
20394 + 7.040
e-03,-1.113
e-02, 1.590
e-03, 7.000
e-04,-2.000
e-04, 0.000
e+00,
20395 +-1.710
e-03, 2.290
e-03, 3.800
e-04,-3.500
e-04, 4.000
e-05, 1.000
e-05/
20396 DATA (((cehlq(ix,it,nx,3,2),ix=1,6),it=1,6),nx=1,2)/
20397 + 1.008
e-01,-7.100
e-02, 1.973
e-02,-5.710
e-03, 2.930
e-03,-9.900
e-04,
20398 +-5.271
e-02,-1.823
e-02, 1.792
e-02,-6.580
e-03, 1.750
e-03,-1.550
e-03,
20399 + 1.220
e-02, 1.763
e-02,-8.690
e-03,-8.800
e-04,-1.160
e-03,-2.100
e-04,
20400 +-1.190
e-03,-7.180
e-03, 2.360
e-03, 1.890
e-03, 7.700
e-04, 4.100
e-04,
20401 +-9.100
e-04, 2.040
e-03,-3.100
e-04,-1.050
e-03,-4.000
e-04,-2.400
e-04,
20402 + 1.190
e-03,-1.700
e-04,-2.000
e-04, 4.200
e-04, 1.700
e-04, 1.000
e-04,
20403 + 1.081
e+00,-1.189
e+00, 3.868
e-01,-8.617
e-02, 1.115
e-02,-1.180
e-03,
20404 + 9.917
e-01,-1.396
e+00, 4.998
e-01,-1.159
e-01, 1.674
e-02,-1.720
e-03,
20405 + 5.099
e-02,-1.338
e-01, 9.173
e-02,-2.885
e-02, 5.890
e-03,-6.500
e-04,
20406 +-3.178
e-02, 5.703
e-02,-2.070
e-02, 2.440
e-03, 1.100
e-04,-9.000
e-05,
20407 + 8.970
e-03,-1.392
e-02, 2.050
e-03, 6.500
e-04,-2.300
e-04, 2.000
e-05,
20408 +-2.340
e-03, 3.010
e-03, 5.000
e-04,-3.900
e-04, 6.000
e-05, 1.000
e-05/
20410 DATA (((cehlq(ix,it,nx,4,1),ix=1,6),it=1,6),nx=1,2)/
20411 + 9.482
e-01,-9.578
e-01, 1.009
e-01,-1.051
e-01, 3.456
e-02,-3.054
e-02,
20412 +-9.627
e-01, 5.379
e-01, 3.368
e-01,-9.525
e-02, 1.488
e-02,-2.051
e-02,
20413 + 4.300
e-01,-8.306
e-02,-3.372
e-01, 4.902
e-02,-9.160
e-03, 1.041
e-02,
20414 +-1.925
e-01,-1.790
e-02, 2.183
e-01, 7.490
e-03, 4.140
e-03,-1.860
e-03,
20415 + 8.183
e-02, 1.926
e-02,-1.072
e-01,-1.944
e-02,-2.770
e-03,-5.200
e-04,
20416 +-3.884
e-02,-1.234
e-02, 5.410
e-02, 1.879
e-02, 3.350
e-03, 1.040
e-03,
20417 + 2.948
e+01,-3.902
e+01, 1.464
e+01,-3.335
e+00, 5.054
e-01,-5.915
e-02,
20418 + 2.559
e+01,-3.955
e+01, 1.661
e+01,-4.299
e+00, 6.904
e-01,-8.243
e-02,
20419 +-1.663
e+00, 1.176
e+00, 1.118
e+00,-7.099
e-01, 1.948
e-01,-2.404
e-02,
20420 +-2.168
e-01, 8.170
e-01,-7.169
e-01, 1.851
e-01,-1.924
e-02,-3.250
e-03,
20421 + 2.088
e-01,-4.355
e-01, 2.239
e-01,-2.446
e-02,-3.620
e-03, 1.910
e-03,
20422 +-9.097
e-02, 1.601
e-01,-5.681
e-02,-2.500
e-03, 2.580
e-03,-4.700
e-04/
20423 DATA (((cehlq(ix,it,nx,4,2),ix=1,6),it=1,6),nx=1,2)/
20424 + 2.367
e+00, 4.453
e-01, 3.660
e-01, 9.467
e-02, 1.341
e-01, 1.661
e-02,
20425 +-3.170
e+00,-1.795
e+00, 3.313
e-02,-2.874
e-01,-9.827
e-02,-7.119
e-02,
20426 + 1.823
e+00, 1.457
e+00,-2.465
e-01, 3.739
e-02, 6.090
e-03, 1.814
e-02,
20427 +-1.033
e+00,-9.827
e-01, 2.136
e-01, 1.169
e-01, 5.001
e-02, 1.684
e-02,
20428 + 5.133
e-01, 5.259
e-01,-1.173
e-01,-1.139
e-01,-4.988
e-02,-2.021
e-02,
20429 +-2.881
e-01,-3.145
e-01, 5.667
e-02, 9.161
e-02, 4.568
e-02, 1.951
e-02,
20430 + 3.036
e+01,-4.062
e+01, 1.578
e+01,-3.699
e+00, 6.020
e-01,-7.031
e-02,
20431 + 2.700
e+01,-4.167
e+01, 1.770
e+01,-4.804
e+00, 7.862
e-01,-1.060
e-01,
20432 +-1.909
e+00, 1.357
e+00, 1.127
e+00,-7.181
e-01, 2.232
e-01,-2.481
e-02,
20433 +-2.488
e-01, 9.781
e-01,-8.127
e-01, 2.094
e-01,-2.997
e-02,-4.710
e-03,
20434 + 2.506
e-01,-5.427
e-01, 2.672
e-01,-3.103
e-02,-1.800
e-03, 2.870
e-03,
20435 +-1.128
e-01, 2.087
e-01,-6.972
e-02,-2.480
e-03, 2.630
e-03,-8.400
e-04/
20437 DATA (((cehlq(ix,it,nx,5,1),ix=1,6),it=1,6),nx=1,2)/
20438 + 4.968
e-02,-4.173
e-02, 2.102
e-02,-3.270
e-03, 3.240
e-03,-6.700
e-04,
20439 +-6.150
e-03,-1.294
e-02, 6.740
e-03,-6.890
e-03, 9.000
e-04,-1.510
e-03,
20440 +-8.580
e-03, 5.050
e-03,-4.900
e-03,-1.600
e-04,-9.400
e-04,-1.500
e-04,
20441 + 7.840
e-03, 1.510
e-03, 2.220
e-03, 1.400
e-03, 7.000
e-04, 3.500
e-04,
20442 +-4.410
e-03,-2.220
e-03,-8.900
e-04,-8.500
e-04,-3.600
e-04,-2.000
e-04,
20443 + 2.520
e-03, 1.840
e-03, 4.100
e-04, 3.900
e-04, 1.600
e-04, 9.000
e-05,
20444 + 9.235
e-01,-1.085
e+00, 3.464
e-01,-7.210
e-02, 9.140
e-03,-9.100
e-04,
20445 + 9.315
e-01,-1.274
e+00, 4.512
e-01,-9.775
e-02, 1.380
e-02,-1.310
e-03,
20446 + 4.739
e-02,-1.296
e-01, 8.482
e-02,-2.642
e-02, 4.760
e-03,-5.700
e-04,
20447 +-2.653
e-02, 4.953
e-02,-1.735
e-02, 1.750
e-03, 2.800
e-04,-6.000
e-05,
20448 + 6.940
e-03,-1.132
e-02, 1.480
e-03, 6.500
e-04,-2.100
e-04, 0.000
e+00,
20449 +-1.680
e-03, 2.340
e-03, 4.200
e-04,-3.400
e-04, 5.000
e-05, 1.000
e-05/
20450 DATA (((cehlq(ix,it,nx,5,2),ix=1,6),it=1,6),nx=1,2)/
20451 + 6.478
e-02,-4.537
e-02, 1.643
e-02,-3.490
e-03, 2.710
e-03,-6.700
e-04,
20452 +-2.223
e-02,-2.126
e-02, 1.247
e-02,-6.290
e-03, 1.120
e-03,-1.440
e-03,
20453 +-1.340
e-03, 1.362
e-02,-6.130
e-03,-7.900
e-04,-9.000
e-04,-2.000
e-04,
20454 + 5.080
e-03,-3.610
e-03, 1.700
e-03, 1.830
e-03, 6.800
e-04, 4.000
e-04,
20455 +-3.580
e-03, 6.000
e-05,-2.600
e-04,-1.050
e-03,-3.800
e-04,-2.300
e-04,
20456 + 2.420
e-03, 9.300
e-04,-1.000
e-04, 4.500
e-04, 1.700
e-04, 1.100
e-04,
20457 + 9.868
e-01,-1.171
e+00, 3.940
e-01,-8.459
e-02, 1.124
e-02,-1.250
e-03,
20458 + 1.001
e+00,-1.383
e+00, 5.044
e-01,-1.152
e-01, 1.658
e-02,-1.830
e-03,
20459 + 4.928
e-02,-1.368
e-01, 9.021
e-02,-2.935
e-02, 5.800
e-03,-6.600
e-04,
20460 +-3.133
e-02, 5.785
e-02,-2.023
e-02, 2.630
e-03, 1.600
e-04,-8.000
e-05,
20461 + 8.840
e-03,-1.416
e-02, 1.900
e-03, 5.800
e-04,-2.500
e-04, 1.000
e-05,
20462 +-2.300
e-03, 3.080
e-03, 5.500
e-04,-3.700
e-04, 7.000
e-05, 1.000
e-05/
20464 DATA (((cehlq(ix,it,nx,6,1),ix=1,6),it=1,6),nx=1,2)/
20465 + 9.270
e-03,-1.817
e-02, 9.590
e-03,-6.390
e-03, 1.690
e-03,-1.540
e-03,
20466 + 5.710
e-03,-1.188
e-02, 6.090
e-03,-4.650
e-03, 1.240
e-03,-1.310
e-03,
20467 +-3.960
e-03, 7.100
e-03,-3.590
e-03, 1.840
e-03,-3.900
e-04, 3.400
e-04,
20468 + 1.120
e-03,-1.960
e-03, 1.120
e-03,-4.800
e-04, 1.000
e-04,-4.000
e-05,
20469 + 4.000
e-05,-3.000
e-05,-1.800
e-04, 9.000
e-05,-5.000
e-05,-2.000
e-05,
20470 +-4.200
e-04, 7.300
e-04,-1.600
e-04, 5.000
e-05, 5.000
e-05, 5.000
e-05,
20471 + 8.098
e-01,-1.042
e+00, 3.398
e-01,-6.824
e-02, 8.760
e-03,-9.000
e-04,
20472 + 8.961
e-01,-1.217
e+00, 4.339
e-01,-9.287
e-02, 1.304
e-02,-1.290
e-03,
20473 + 3.058
e-02,-1.040
e-01, 7.604
e-02,-2.415
e-02, 4.600
e-03,-5.000
e-04,
20474 +-2.451
e-02, 4.432
e-02,-1.651
e-02, 1.430
e-03, 1.200
e-04,-1.000
e-04,
20475 + 1.122
e-02,-1.457
e-02, 2.680
e-03, 5.800
e-04,-1.200
e-04, 3.000
e-05,
20476 +-7.730
e-03, 7.330
e-03,-7.600
e-04,-2.400
e-04, 1.000
e-05, 0.000
e+00/
20477 DATA (((cehlq(ix,it,nx,6,2),ix=1,6),it=1,6),nx=1,2)/
20478 + 9.980
e-03,-1.945
e-02, 1.055
e-02,-6.870
e-03, 1.860
e-03,-1.560
e-03,
20479 + 5.700
e-03,-1.203
e-02, 6.250
e-03,-4.860
e-03, 1.310
e-03,-1.370
e-03,
20480 +-4.490
e-03, 7.990
e-03,-4.170
e-03, 2.050
e-03,-4.400
e-04, 3.300
e-04,
20481 + 1.470
e-03,-2.480
e-03, 1.460
e-03,-5.700
e-04, 1.200
e-04,-1.000
e-05,
20482 +-9.000
e-05, 1.500
e-04,-3.200
e-04, 1.200
e-04,-6.000
e-05,-4.000
e-05,
20483 +-4.200
e-04, 7.600
e-04,-1.400
e-04, 4.000
e-05, 7.000
e-05, 5.000
e-05,
20484 + 8.698
e-01,-1.131
e+00, 3.836
e-01,-8.111
e-02, 1.048
e-02,-1.300
e-03,
20485 + 9.626
e-01,-1.321
e+00, 4.854
e-01,-1.091
e-01, 1.583
e-02,-1.700
e-03,
20486 + 3.057
e-02,-1.088
e-01, 8.022
e-02,-2.676
e-02, 5.590
e-03,-5.600
e-04,
20487 +-2.845
e-02, 5.164
e-02,-1.918
e-02, 2.210
e-03,-4.000
e-05,-1.500
e-04,
20488 + 1.311
e-02,-1.751
e-02, 3.310
e-03, 5.100
e-04,-1.200
e-04, 5.000
e-05,
20489 +-8.590
e-03, 8.380
e-03,-9.200
e-04,-2.600
e-04, 1.000
e-05,-1.000
e-05/
20491 DATA (((cehlq(ix,it,nx,7,1),ix=1,6),it=1,6),nx=1,2)/
20492 + 9.010
e-03,-1.401
e-02, 7.150
e-03,-4.130
e-03, 1.260
e-03,-1.040
e-03,
20493 + 6.280
e-03,-9.320
e-03, 4.780
e-03,-2.890
e-03, 9.100
e-04,-8.200
e-04,
20494 +-2.930
e-03, 4.090
e-03,-1.890
e-03, 7.600
e-04,-2.300
e-04, 1.400
e-04,
20495 + 3.900
e-04,-1.200
e-03, 4.400
e-04,-2.500
e-04, 2.000
e-05,-2.000
e-05,
20496 + 2.600
e-04, 1.400
e-04,-8.000
e-05, 1.000
e-04, 1.000
e-05, 1.000
e-05,
20497 +-2.600
e-04, 3.200
e-04, 1.000
e-05,-1.000
e-05, 1.000
e-05,-1.000
e-05,
20498 + 8.029
e-01,-1.075
e+00, 3.792
e-01,-7.843
e-02, 1.007
e-02,-1.090
e-03,
20499 + 7.903
e-01,-1.099
e+00, 4.153
e-01,-9.301
e-02, 1.317
e-02,-1.410
e-03,
20500 +-1.704
e-02,-1.130
e-02, 2.882
e-02,-1.341
e-02, 3.040
e-03,-3.600
e-04,
20501 +-7.200
e-04, 7.230
e-03,-5.160
e-03, 1.080
e-03,-5.000
e-05,-4.000
e-05,
20502 + 3.050
e-03,-4.610
e-03, 1.660
e-03,-1.300
e-04,-1.000
e-05, 1.000
e-05,
20503 +-4.360
e-03, 5.230
e-03,-1.610
e-03, 2.000
e-04,-2.000
e-05, 0.000
e+00/
20504 DATA (((cehlq(ix,it,nx,7,2),ix=1,6),it=1,6),nx=1,2)/
20505 + 8.980
e-03,-1.459
e-02, 7.510
e-03,-4.410
e-03, 1.310
e-03,-1.070
e-03,
20506 + 5.970
e-03,-9.440
e-03, 4.800
e-03,-3.020
e-03, 9.100
e-04,-8.500
e-04,
20507 +-3.050
e-03, 4.440
e-03,-2.100
e-03, 8.500
e-04,-2.400
e-04, 1.400
e-04,
20508 + 5.300
e-04,-1.300
e-03, 5.600
e-04,-2.700
e-04, 3.000
e-05,-2.000
e-05,
20509 + 2.000
e-04, 1.400
e-04,-1.100
e-04, 1.000
e-04, 0.000
e+00, 0.000
e+00,
20510 +-2.600
e-04, 3.200
e-04, 0.000
e+00,-3.000
e-05, 1.000
e-05,-1.000
e-05,
20511 + 8.672
e-01,-1.174
e+00, 4.265
e-01,-9.252
e-02, 1.244
e-02,-1.460
e-03,
20512 + 8.500
e-01,-1.194
e+00, 4.630
e-01,-1.083
e-01, 1.614
e-02,-1.830
e-03,
20513 +-2.241
e-02,-5.630
e-03, 2.815
e-02,-1.425
e-02, 3.520
e-03,-4.300
e-04,
20514 +-7.300
e-04, 8.030
e-03,-5.780
e-03, 1.380
e-03,-1.300
e-04,-4.000
e-05,
20515 + 3.460
e-03,-5.380
e-03, 1.960
e-03,-2.100
e-04, 1.000
e-05, 1.000
e-05,
20516 +-4.850
e-03, 5.950
e-03,-1.890
e-03, 2.600
e-04,-3.000
e-05, 0.000
e+00/
20518 DATA (((cehlq(ix,it,nx,8,1),ix=1,6),it=1,6),nx=1,2)/
20519 + 4.410
e-03,-7.480
e-03, 3.770
e-03,-2.580
e-03, 7.300
e-04,-7.100
e-04,
20520 + 3.840
e-03,-6.050
e-03, 3.030
e-03,-2.030
e-03, 5.800
e-04,-5.900
e-04,
20521 +-8.800
e-04, 1.660
e-03,-7.500
e-04, 4.700
e-04,-1.000
e-04, 1.000
e-04,
20522 +-8.000
e-05,-1.500
e-04, 1.200
e-04,-9.000
e-05, 3.000
e-05, 0.000
e+00,
20523 + 1.300
e-04,-2.200
e-04,-2.000
e-05,-2.000
e-05,-2.000
e-05,-2.000
e-05,
20524 +-7.000
e-05, 1.900
e-04,-4.000
e-05, 2.000
e-05, 0.000
e+00, 0.000
e+00,
20525 + 6.623
e-01,-9.248
e-01, 3.519
e-01,-7.930
e-02, 1.110
e-02,-1.180
e-03,
20526 + 6.380
e-01,-9.062
e-01, 3.582
e-01,-8.479
e-02, 1.265
e-02,-1.390
e-03,
20527 +-2.581
e-02, 2.125
e-02, 4.190
e-03,-4.980
e-03, 1.490
e-03,-2.100
e-04,
20528 + 7.100
e-04, 5.300
e-04,-1.270
e-03, 3.900
e-04,-5.000
e-05,-1.000
e-05,
20529 + 3.850
e-03,-5.060
e-03, 1.860
e-03,-3.500
e-04, 4.000
e-05, 0.000
e+00,
20530 +-3.530
e-03, 4.460
e-03,-1.500
e-03, 2.700
e-04,-3.000
e-05, 0.000
e+00/
20531 DATA (((cehlq(ix,it,nx,8,2),ix=1,6),it=1,6),nx=1,2)/
20532 + 4.260
e-03,-7.530
e-03, 3.830
e-03,-2.680
e-03, 7.600
e-04,-7.300
e-04,
20533 + 3.640
e-03,-6.050
e-03, 3.030
e-03,-2.090
e-03, 5.900
e-04,-6.000
e-04,
20534 +-9.200
e-04, 1.710
e-03,-8.200
e-04, 5.000
e-04,-1.200
e-04, 1.000
e-04,
20535 +-5.000
e-05,-1.600
e-04, 1.300
e-04,-9.000
e-05, 3.000
e-05, 0.000
e+00,
20536 + 1.300
e-04,-2.100
e-04,-1.000
e-05,-2.000
e-05,-2.000
e-05,-1.000
e-05,
20537 +-8.000
e-05, 1.800
e-04,-5.000
e-05, 2.000
e-05, 0.000
e+00, 0.000
e+00,
20538 + 7.146
e-01,-1.007
e+00, 3.932
e-01,-9.246
e-02, 1.366
e-02,-1.540
e-03,
20539 + 6.856
e-01,-9.828
e-01, 3.977
e-01,-9.795
e-02, 1.540
e-02,-1.790
e-03,
20540 +-3.053
e-02, 2.758
e-02, 2.150
e-03,-4.880
e-03, 1.640
e-03,-2.500
e-04,
20541 + 9.200
e-04, 4.200
e-04,-1.340
e-03, 4.600
e-04,-8.000
e-05,-1.000
e-05,
20542 + 4.230
e-03,-5.660
e-03, 2.140
e-03,-4.300
e-04, 6.000
e-05, 0.000
e+00,
20543 +-3.890
e-03, 5.000
e-03,-1.740
e-03, 3.300
e-04,-4.000
e-05, 0.000
e+00/
20548 DATA ((cdo(ip,is,1,1),is=1,6),ip=1,3)/
20549 + 4.190
e-01, 3.460
e+00, 4.400
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20550 + 4.000
e-03, 7.240
e-01,-4.860
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20551 +-7.000
e-03,-6.600
e-02, 1.330
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00/
20552 DATA ((cdo(ip,is,1,2),is=1,6),ip=1,3)/
20553 + 3.740
e-01, 3.330
e+00, 6.030
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20554 + 1.400
e-02, 7.530
e-01,-6.220
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20555 + 0.000
e+00,-7.600
e-02, 1.560
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00/
20557 DATA ((cdo(ip,is,2,1),is=1,6),ip=1,3)/
20558 + 7.630
e-01, 4.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20559 +-2.370
e-01, 6.270
e-01,-4.210
e-01, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20560 + 2.600
e-02,-1.900
e-02, 3.300
e-02, 0.000
e+00, 0.000
e+00, 0.000
e+00/
20561 DATA ((cdo(ip,is,2,2),is=1,6),ip=1,3)/
20562 + 7.610
e-01, 3.830
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20563 +-2.320
e-01, 6.270
e-01,-4.180
e-01, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20564 + 2.300
e-02,-1.900
e-02, 3.600
e-02, 0.000
e+00, 0.000
e+00, 0.000
e+00/
20566 DATA ((cdo(ip,is,3,1),is=1,6),ip=1,3)/
20567 + 1.265
e+00, 0.000
e+00, 8.050
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20568 +-1.132
e+00,-3.720
e-01, 1.590
e+00, 6.310
e+00,-1.050
e+01, 1.470
e+01,
20569 + 2.930
e-01,-2.900
e-02,-1.530
e-01,-2.730
e-01,-3.170
e+00, 9.800
e+00/
20570 DATA ((cdo(ip,is,3,2),is=1,6),ip=1,3)/
20571 + 1.670
e+00, 0.000
e+00, 9.150
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20572 +-1.920
e+00,-2.730
e-01, 5.300
e-01, 1.570
e+01,-1.010
e+02, 2.230
e+02,
20573 + 5.820
e-01,-1.640
e-01,-7.630
e-01,-2.830
e+00, 4.470
e+01,-1.170
e+02/
20575 DATA ((cdo(ip,is,4,1),is=1,6),ip=1,3)/
20576 + 0.000
e+00,-3.600
e-02, 6.350
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00,
20577 + 1.350
e-01,-2.220
e-01, 3.260
e+00,-3.030
e+00, 1.740
e+01,-1.790
e+01,
20578 +-7.500
e-02,-5.800
e-02,-9.090
e-01, 1.500
e+00,-1.130
e+01, 1.560
e+01/
20579 DATA ((cdo(ip,is,4,2),is=1,6),ip=1,3)/ 0.000
e+00,-1.200
e-01,
20580 +3.510
e+00, 0.000
e+00, 0.000
e+00, 0.000
e+00, 6.700
e-02,-2.330
e-01,
20581 +3.660
e+00,-4.740
e-01, 9.500
e+00,-1.660
e+01,-3.100
e-02,-2.300
e-02,
20582 +-4.530
e-01, 3.580
e-01,-5.430
e+00, 1.550
e+01/
20584 DATA ((cdo(ip,is,5,1),is=1,6),ip=1,3)/
20585 + 1.560
e+00, 0.000
e+00, 6.000
e+00, 9.000
e+00, 0.000
e+00, 0.000
e+00,
20586 +-1.710
e+00,-9.490
e-01, 1.440
e+00,-7.190
e+00,-1.650
e+01, 1.530
e+01,
20587 + 6.380
e-01, 3.250
e-01,-1.050
e+00, 2.550
e-01, 1.090
e+01,-1.010
e+01/
20588 DATA ((cdo(ip,is,5,2),is=1,6),ip=1,3)/
20589 + 8.790
e-01, 0.000
e+00, 4.000
e+00, 9.000
e+00, 0.000
e+00, 0.000
e+00,
20590 +-9.710
e-01,-1.160
e+00, 1.230
e+00,-5.640
e+00,-7.540
e+00,-5.960
e-01,
20591 + 4.340
e-01, 4.760
e-01,-2.540
e-01,-8.170
e-01, 5.500
e+00, 1.260
e-01/
20598 DATA (((cmt(iex,ipn,ifl,1),ifl=1,9),ipn=0,2),iex=0,3)/
20599 + 1.30, 1.64, 1.86, -0.60, -0.45, -1.10, -3.87, -6.14,-12.53,
20600 + -0.57, -0.33, -2.76, -1.68, -1.64, -1.66, 0.79, 2.65, 8.13,
20601 + -0.08, -0.10, 0.10, 0.08, 0.05, 0.13, -0.70, -1.24, -2.64,
20602 + 0.18, 0.08, -0.17, -0.19, -0.18, -0.19, -0.03, -0.10, -0.38,
20603 + 0.16, 0.14, -0.07, -0.16, -0.19, -0.09, -0.17, -0.03, 0.34,
20604 + -0.02, -0.01, 0.02, 0.04, 0.06, 0.01, 0.03, -0.02, -0.14,
20605 + 5.27, 3.74, 7.33, 9.31, 9.36, 9.07, 7.96, 6.90, 16.30,
20606 + 0.43, 0.54, -0.88, -1.17, -1.01, -1.39, 0.95, 1.52,-13.23,
20607 + 0.06, 0.03, -0.08, 0.29, 0.20, 0.47, -0.38, -0.50, 4.77,
20608 + -1.85, -2.04, -0.88, -1.45, -1.48, -1.26, 0.60, 0.80, -0.57,
20609 + 1.08, 0.88, 2.47, 1.65, 1.49, 1.96, 0.60, 1.05, 3.58,
20610 + -0.03, 0.02, -0.32, -0.20, -0.12, -0.36, 0.08, -0.14, -0.99/
20612 DATA (((cmt(iex,ipn,ifl,2),ifl=1,9),ipn=0,2),iex=0,3)/
20613 + 1.34, 1.62, 1.88, -0.99, -0.99, -0.99, -3.98, -6.28,-13.08,
20614 + -0.57, -0.33, -2.78, -1.54, -1.54, -1.54, 0.72, 2.62, 8.54,
20615 + -0.08, -0.10, 0.13, 0.10, 0.10, 0.10, -0.63, -1.18, -2.70,
20616 + 0.15, 0.11, -0.33, -0.33, -0.33, -0.33, -0.15, -0.18, -0.40,
20617 + 0.16, 0.14, 0.10, 0.03, 0.03, 0.03, -0.06, 0.02, 0.31,
20618 + -0.02, -0.01, -0.04, -0.03, -0.03, -0.03, 0.00, -0.03, -0.12,
20619 + 5.30, 3.68, 7.52, 8.53, 8.53, 8.53, 7.46, 6.56, 15.35,
20620 + 0.43, 0.53, -1.13, -1.08, -1.08, -1.08, 0.96, 1.40,-11.83,
20621 + 0.06, 0.03, 0.04, 0.39, 0.39, 0.39, -0.30, -0.38, 4.16,
20622 + -1.96, -1.94, -1.34, -1.55, -1.55, -1.55, 0.35, 0.65, -0.43,
20623 + 1.08, 0.87, 2.92, 2.02, 2.02, 2.02, 0.89, 1.13, 3.18,
20624 + -0.03, 0.02, -0.49, -0.39, -0.39, -0.39, -0.04, -0.16, -0.82/
20626 DATA (((cmt(iex,ipn,ifl,3),ifl=1,9),ipn=0,2),iex=0,3)/
20627 + 1.38, 1.64, 1.52, -0.85, -0.85, -0.85, -3.74, -6.07,-12.08,
20628 + -0.59, -0.33, -2.71, -1.43, -1.43, -1.43, 0.21, 2.33, 7.31,
20629 + -0.08, -0.10, 0.15, -0.03, -0.03, -0.03, -0.50, -1.15, -2.35,
20630 + 0.18, 0.09, -0.72, -0.82, -0.82, -0.82, -0.58, -0.52, -0.73,
20631 + 0.16, 0.14, 0.45, 0.35, 0.35, 0.35, 0.24, 0.22, 0.54,
20632 + -0.02, -0.01, -0.15, -0.09, -0.10, -0.10, -0.07, -0.07, -0.18,
20633 + 5.40, 3.74, 7.75, 9.19, 9.19, 9.19, 9.63, 8.33, 21.14,
20634 + 0.42, 0.54, -1.56, -0.92, -0.92, -0.92, -1.13, 0.28,-19.17,
20635 + 0.06, 0.03, 0.16, 0.12, 0.12, 0.12, 0.25, -0.28, 6.64,
20636 + -1.91, -2.02, -2.18, -2.76, -2.76, -2.76, -1.09, -0.52, -1.92,
20637 + 1.11, 0.88, 3.75, 2.56, 2.56, 2.56, 2.10, 1.91, 4.59,
20638 + -0.03, 0.02, -0.76, -0.40, -0.40, -0.40, -0.33, -0.31, -1.25/
20640 DATA (((cmt(iex,ipn,ifl,4),ifl=1,9),ipn=0,2),iex=0,3)/
20641 + 1.43, 1.69, 2.11, -0.84, -0.84, -0.84, -3.87, -6.09,-12.56,
20642 + -0.65, -0.33, -3.01, -1.65, -1.65, -1.65, 0.85, 2.81, 8.69,
20643 + -0.08, -0.11, 0.18, 0.12, 0.12, 0.12, -0.73, -1.34, -2.93,
20644 + 0.16, 0.11, -0.33, -0.32, -0.32, -0.32, -0.15, -0.17, -0.38,
20645 + 0.16, 0.14, 0.10, 0.02, 0.02, 0.02, -0.07, 0.01, 0.30,
20646 + -0.02, -0.01, -0.04, -0.03, -0.03, -0.03, 0.00, -0.03, -0.12,
20647 + 6.17, 3.69, 7.93, 8.96, 8.96, 8.96, 7.83, 6.75, 14.62,
20648 + 0.43, 0.54, -1.40, -1.24, -1.24, -1.24, 1.00, 1.74,-11.27,
20649 + 0.06, 0.03, 0.09, 0.45, 0.45, 0.45, -0.36, -0.56, 4.29,
20650 + -1.94, -1.99, -1.51, -1.70, -1.70, -1.70, 0.21, 0.54, -0.41,
20651 + 1.12, 0.90, 3.14, 2.15, 2.15, 2.15, 0.93, 1.15, 3.19,
20652 + -0.02, 0.02, -0.55, -0.43, -0.43, -0.43, -0.03, -0.16, -0.87/
20659 IF(lst(15).LT.0) mstp57=0
20660 mstp51=iabs(lst(15))
20670 IF(mstp51.EQ.1.OR.mstp51.EQ.2)
THEN
20676 IF(nset.EQ.1) alam=0.2
20677 IF(nset.EQ.2) alam=0.29
20678 tmin=
log(5./alam**2)
20679 tmax=
log(1e8/alam**2)
20680 IF(mstp57.EQ.0)
THEN
20683 t=
log(max(1.,q2/alam**2))
20685 vt=max(-1.,min(1.,(2.*
t-tmax-tmin)/(tmax-tmin)))
20688 IF(nx.EQ.1) vx=(2.*
x-1.1)/0.9
20689 IF(nx.EQ.2) vx=max(-1.,(2.*
log(
x)+11.51293)/6.90776)
20691 IF(
x.LT.1
e-4.AND.abs(parp51-1.).GT.0.01) cxs=
20692 + (1
e-4/
x)**(parp51-1.)
20698 tx(4)=4.*vx**3-3.*vx
20699 tx(5)=8.*vx**4-8.*vx**2+1.
20700 tx(6)=16.*vx**5-20.*vx**3+5.*vx
20704 tt(4)=4.*vt**3-3.*vt
20705 tt(5)=8.*vt**4-8.*vt**2+1.
20706 tt(6)=16.*vt**5-20.*vt**3+5.*vt
20713 20 xqsum=xqsum+cehlq(ix,it,nx,kfl,nset)*
tx(ix)*
tt(it)
20714 30 xq(kfl)=xqsum*(1.-
x)**nehlq(kfl,nset)*cxs
20718 xppr(1)=xq(2)+xq(3)
20719 xppr(2)=xq(1)+xq(3)
20728 IF(mstp58.GE.5)
THEN
20729 IF(nset.EQ.1) tmin=8.1905
20730 IF(nset.EQ.2) tmin=7.4474
20732 vt=max(-1.,min(1.,(2.*
t-tmax-tmin)/(tmax-tmin)))
20736 tt(4)=4.*vt**3-3.*vt
20737 tt(5)=8.*vt**4-8.*vt**2+1.
20738 tt(6)=16.*vt**5-20.*vt**3+5.*vt
20742 40 xqsum=xqsum+cehlq(ix,it,nx,7,nset)*
tx(ix)*
tt(it)
20743 xppr(5)=xqsum*(1.-
x)**nehlq(7,nset)*cxs
20749 IF(mstp58.GE.6)
THEN
20750 IF(nset.EQ.1) tmin=11.5528
20751 IF(nset.EQ.2) tmin=10.8097
20752 tmin=tmin+2.*
log(pmas(6,1)/30.)
20753 tmax=tmax+2.*
log(pmas(6,1)/30.)
20755 vt=max(-1.,min(1.,(2.*
t-tmax-tmin)/(tmax-tmin)))
20759 tt(4)=4.*vt**3-3.*vt
20760 tt(5)=8.*vt**4-8.*vt**2+1.
20761 tt(6)=16.*vt**5-20.*vt**3+5.*vt
20765 50 xqsum=xqsum+cehlq(ix,it,nx,8,nset)*
tx(ix)*
tt(it)
20766 xppr(6)=xqsum*(1.-
x)**nehlq(8,nset)*cxs
20771 ELSEIF(mstp51.EQ.3.OR.mstp51.EQ.4)
THEN
20777 IF(nset.EQ.1) alam=0.2
20778 IF(nset.EQ.2) alam=0.4
20779 IF(mstp57.LE.0)
THEN
20782 q2in=min(1e6,max(4.,q2))
20783 sd=
log(
log(q2in/alam**2)/
log(4./alam**2))
20789 60 ts(is)=cdo(1,is,kfl,nset)+cdo(2,is,kfl,nset)*sd+ cdo(3,is,
20792 xq(kfl)=
x**ts(1)*(1.-
x)**ts(2)*(1.+ts(3)*
x)/(eulbet(ts(1),
20793 + ts(2)+1.)*(1.+ts(3)*ts(1)/(ts(1)+ts(2)+1.)))
20795 xq(kfl)=ts(1)*
x**ts(2)*(1.-
x)**ts(3)*(1.+ts(4)*
x+ts(5)*
x**
20802 xppr(1)=xq(2)+xq(3)/6.
20803 xppr(2)=3.*xq(1)-xq(2)+xq(3)/6.
20811 ELSEIF(mstp51.GE.5.AND.mstp51.LE.8)
THEN
20817 IF(nset.EQ.1) alam=0.187
20818 IF(nset.EQ.2) alam=0.212
20819 IF(nset.EQ.3) alam=0.191
20820 IF(nset.EQ.4) alam=0.155
20821 IF(mstp57.EQ.0)
THEN
20824 sd=
log(
log(max(4.,q2)/alam**2)/
log(4./alam**2))
20826 xl=
log(max(1
e-10,
x))
20827 x1l=
log(max(1
e-10,1.-
x))
20828 xll=
log(max(1
e-10,
log(1.+1./max(1
e-10,
x))))
20833 80 exmt(iex)=cmt(iex,0,ip,nset)+cmt(iex,1,ip,nset)*sd+ cmt(iex,
20835 exmts=exmt(0)+exmt(1)*xl+exmt(2)*x1l+exmt(3)*xll
20836 IF(exmts.LT.-50.)
THEN
20842 IF(q2.LE.2.25) xq(7)=0.
20843 IF(q2.LE.25.0) xq(8)=0.
20847 IF(mstp57.EQ.0.OR.q2.LE.pmas(6,1)**2)
THEN
20850 sd=
log(
log(max(4.,q2)/alam**2*(100./pmas(6,1))**2)/
20853 100 exmt(iex)=cmt(iex,0,9,nset)+cmt(iex,1,9,nset)*sd+
20854 + cmt(iex,2,9,nset)*sd**2
20855 exmts=exmt(0)+exmt(1)*xl+exmt(2)*x1l+exmt(3)*xll
20856 IF(exmts.LT.-50.)
THEN
20865 xppr(1)=xq(1)+xq(5)
20867 xppr(2)=xq(2)+xq(4)
20878 ELSEIF(mstp51.EQ.9)
THEN
20886 IF(mstp57.EQ.0)
THEN
20889 q2in=min(1e8,max(0.2,q2))
20890 sd=
log(
log(q2in/alam**2)/
log(0.2/alam**2))
20896 xq(1)=(0.794+0.312*sd)*xc**(0.427-0.011*sd)*
20897 + (1.+(6.887-2.227*sd)*xc+(-11.083+2.136*sd)*xc**2+
20898 + (3.900+1.079*sd)*xc**3)*(1.-xc)**(1.037+1.077*sd)
20899 xq(2)=(0.486+0.139*sd)*xc**(0.434-0.018*sd)*
20900 + (1.+(7.716-2.684*sd)*xc+(-12.768+3.122*sd)*xc**2+
20901 + (4.564+0.470*sd)*xc**3)*(1.-xc)**(1.889+1.129*sd)
20902 xq(3)=(xc**(0.415+0.186*sd)*((0.786+0.942*sd)+
20903 + (5.256-5.810*sd)*xc+(-4.599+5.842*sd)*xc**2)+sd**0.592*
20904 +
exp(-(0.398+2.135*sd)+
sqrt(3.779*sd**1.250*xl)))*
20905 + (1.-xc)**(1.622+1.980*sd)
20906 xq(4)=sd**0.448*(1.-xc)**(5.540-0.445*sd)*
20907 +
exp(-(4.668+1.230*sd)+
sqrt((13.173-1.361*sd)*sd**0.442*xl))/
20908 + xl**(3.181-0.862*sd)
20910 IF(sd.GT.1.125) xq(5)=(sd-1.125)*(1.-xc)**(2.038+1.022*sd)*
20911 +
exp(-(4.290+1.569*sd)+
sqrt((2.982+1.452*sd)*sd**0.5*xl))
20913 IF(sd.GT.1.603) xq(6)=(sd-1.603)*(1.-xc)**(2.230+1.052*sd)*
20914 +
exp(-(4.566+1.559*sd)+
sqrt((4.147+1.268*sd)*sd**0.5*xl))
20918 IF(
x.LT.1
e-6.AND.abs(parp51-1.).GT.0.01)
20919 + cxs=(1
e-6/
x)**(parp51-1.)
20921 xppr(1)=cxs*(xq(2)+xq(4))
20923 xppr(2)=cxs*(xq(1)+xq(4))
20932 ELSEIF(mstp51.EQ.10)
THEN
20940 IF(mstp57.EQ.0)
THEN
20943 q2in=min(1e8,max(0.2,q2))
20944 sd=
log(
log(q2in/alam**2)/
log(0.2/alam**2))
20951 xq(1)=(1.364+0.989*sd-0.236*sd2)*xc**(0.593-0.048*sd)*
20952 + (1.+(8.912-6.092*sd+0.852*sd2)*xc+(-16.737+7.039*sd)*xc**2+
20953 + (10.275+0.806*sd-2.000*sd2)*xc**3)*
20954 + (1.-xc)**(2.043+1.408*sd-0.283*sd2)
20955 xq(2)=(0.835+0.527*sd-0.144*sd2)*xc**(0.600-0.054*sd)*
20956 + (1.+(10.245-7.821*sd+1.325*sd2)*xc+(-19.511+10.940*sd-
20957 + 1.133*sd2)*xc**2+(12.836-2.570*sd-1.041*sd2)*xc**3)*
20958 + (1.-xc)**(3.083+1.382*sd-0.276*sd2)
20959 xq(3)=(xc**(0.321-0.135*sd)*((10.51-2.299*sd)+
20960 + (-17.28+0.755*sd)*xc+(8.242+2.543*sd)*xc**2)*
20961 + xl**(-2.023-0.103*sd)+sd**1.044*
20962 +
exp(-(-1.178+2.792*sd)+
sqrt(2.318*sd**1.673*xl)))*
20963 + (1.-xc)**(3.720+2.337*sd-0.199*sd2)
20964 xq(4)=sd**0.761*(1.+(6.078-2.065*sd)*xc)*(1.-xc)**(4.654+
20965 + 0.603*sd-0.326*sd2)*
exp(-(4.231+1.036*sd)+
sqrt(3.419*sd**0.316*
20966 + xl))/xl**(0.897-0.618*sd)
20968 IF(sd.GT.0.918) xq(5)=(sd-0.918)*(1.-xc)**(3.328+0.859*sd)*
20969 +
exp(-(3.837+1.504*sd)+
sqrt((2.150+1.291*sd)*sd**0.5*xl))
20971 IF(sd.GT.1.353) xq(6)=(sd-1.353)*(1.-xc)**(3.382+0.909*sd)*
20972 +
exp(-(4.130+1.486*sd)+
sqrt((2.895+1.240*sd)*sd**0.5*xl))
20976 IF(
x.LT.1
e-6.AND.abs(parp51-1.).GT.0.01)
20977 + cxs=(1
e-6/
x)**(parp51-1.)
20979 xppr(1)=cxs*(xq(2)+xq(4))
20981 xppr(2)=cxs*(xq(1)+xq(4))
20997 SUBROUTINE ranmar(RVEC,ISEQ)
20999 CALL ranlux(rvec,iseq)
21021 common/cfread/space(5000)
21022 common/mykeys/ievar,if5cc,ineut,iinte,iferm,iflat,icoun,
21023 & refix,imudo,ikat1,ikat2,ikat3,ikat4,ikat5,ikat6,
21024 & inevt,ijak1,ijak2,iitdk,rptau,rxk0d,ntgr,idimuon,iglu,
21025 & iqden,lome(2),ifiles,iccha,iseed,idsubs,ionem,ehac,ipsel,
21032 CALL ffkey(
'PSEL',ipsel,1,
'INTEGER')
21033 CALL ffkey(
'SEED',iseed,1,
'INTEGER')
21034 CALL ffkey(
'IGLU',iglu,1,
'INTEGER')
21035 CALL ffkey(
'EVAR',ievar,1,
'INTEGER')
21036 CALL ffkey(
'F5CC',if5cc,1,
'INTEGER')
21037 CALL ffkey(
'NEUT',ineut,1,
'INTEGER')
21038 CALL ffkey(
'INTE',iinte,1,
'INTEGER')
21039 CALL ffkey(
'FERM',iferm,1,
'INTEGER')
21040 CALL ffkey(
'FLAT',iflat,1,
'INTEGER')
21041 CALL ffkey(
'COUN',icoun,1,
'INTEGER')
21042 CALL ffkey(
'HIST',ihist,1,
'INTEGER')
21043 CALL ffkey(
'EFIX',refix,1,
'REAL')
21044 CALL ffkey(
'QDEN',iqden,1,
'INTEGER')
21045 CALL ffkey(
'MUDO',imudo,1,
'INTEGER')
21046 CALL ffkey(
'NGTR',ntgr,1,
'INTEGER')
21047 CALL ffkey(
'DIMU',idimuon,1,
'INTEGER')
21048 CALL ffkey(
'CCHA',iccha,1,
'INTEGER')
21049 CALL ffkey(
'LOME',lome,2,
'INTEGER')
21050 CALL ffkey(
'FILE',ifiles,1,
'INTEGER')
21051 CALL ffkey(
'KAT1',ikat1,1,
'INTEGER')
21052 CALL ffkey(
'KAT2',ikat2,1,
'INTEGER')
21053 CALL ffkey(
'KAT3',ikat3,1,
'INTEGER')
21054 CALL ffkey(
'KAT4',ikat4,1,
'INTEGER')
21055 CALL ffkey(
'KAT5',ikat5,1,
'INTEGER')
21056 CALL ffkey(
'KAT6',ikat6,1,
'INTEGER')
21057 CALL ffkey(
'NEVT',inevt,1,
'INTEGER')
21058 CALL ffkey(
'JAK1',ijak1,1,
'INTEGER')
21059 CALL ffkey(
'JAK2',ijak2,1,
'INTEGER')
21060 CALL ffkey(
'ITDK',iitdk,1,
'INTEGER')
21061 CALL ffkey(
'DSUBS',idsubs,1,
'INTEGER')
21062 CALL ffkey(
'PTAU',rptau,1,
'REAL')
21063 CALL ffkey(
'XK0D',rxk0d,1,
'REAL')
21064 CALL ffkey(
'EHAC',ehac,1,
'REAL')
21068 OPEN(ninp,
file=
"./jetta.crd",
status=
'UNKNOWN')
21069 CALL ffset(
'LINP',ninp)
21073 IF (ntgr.EQ.0) ntgr=1
21074 IF (iitdk.EQ.0) iitdk=1
21075 IF (rxk0d.EQ.0.) rxk0d=0.001
21087 parameter(nmxhep=2000)
21089 DOUBLE PRECISION phep,vhep
21090 common/
hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
21091 &jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
21101 DOUBLE PRECISION FUNCTION riwfun(V)
21102 DOUBLE PRECISION v(2)
21103 COMMON /leptou/ cut(14),lst(40),parl(30),
x,
y,w2,q2,u
21104 COMMON /lintrl/ psave(3,4,5),ksave(4),
xmin,
xmax,ymin,ymax,
21105 &q2min,q2max,w2min,w2max,ilep,inu,ig,
iz
21106 DATA v2min,v2max/2*0./
21111 IF(lst(31).EQ.1)
THEN
21114 ELSEIF(lst(31).EQ.2)
THEN
21117 ELSEIF(lst(31).EQ.3)
THEN
21121 v1=v1min+v(1)*(v1max-v1min)
21122 v2=v2min+v(2)*(v2max-v2min)
21134 IMPLICIT REAL*8(
a-h,o-
z)
21135 common/store/xa(11),xb(11),xc(11),xd(11),ma(11),mb(11),mc(11)
21136 common/store1/
r(10000),lr
21137 common/option/iprriw,iconv,ireset
21138 common/random/nshots
21140 COMMON /lpflag/ lst3
21142 IF(
init.EQ.1)
RETURN
21158 IF(lst3.GE.4)
WRITE(6,10000) iprriw
21160 10000
FORMAT(5
x,
'RIWIAD PRINT FLAG CHANGED: IPRRIW =',i5)
21165 REAL*4 FUNCTION rlu(IDUMMY)
21166 CALL ranlux(rtim,1)
21173 SUBROUTINE rotod1(PH1,PVEC,QVEC)
21178 IMPLICIT DOUBLE PRECISION (
a-h,o-
z)
21179 dimension pvec(4),qvec(4),rvec(4)
21187 qvec(2)= cs*rvec(2)-sn*rvec(3)
21188 qvec(3)= sn*rvec(2)+cs*rvec(3)
21194 REAL*4 FUNCTION rndmm(IDUMMY)
21195 CALL ranlux(rtim,1)
21201 SUBROUTINE rotod2(PH1,PVEC,QVEC)
21206 IMPLICIT DOUBLE PRECISION (
a-h,o-
z)
21207 dimension pvec(4),qvec(4),rvec(4)
21214 qvec(1)= cs*rvec(1)+sn*rvec(3)
21216 qvec(3)=-sn*rvec(1)+cs*rvec(3)
21222 SUBROUTINE rotod3(PH1,PVEC,QVEC)
21227 IMPLICIT DOUBLE PRECISION (
a-h,o-
z)
21229 dimension pvec(4),qvec(4),rvec(4)
21235 qvec(1)= cs*rvec(1)-sn*rvec(2)
21236 qvec(2)= sn*rvec(1)+cs*rvec(2)
21242 SUBROUTINE rotor1(PH1,PVEC,QVEC)
21247 REAL*4 pvec(4),qvec(4),rvec(4)
21255 qvec(2)= cs*rvec(2)-sn*rvec(3)
21256 qvec(3)= sn*rvec(2)+cs*rvec(3)
21261 SUBROUTINE rotor2(PH1,PVEC,QVEC)
21266 IMPLICIT REAL*4(
a-h,o-
z)
21267 REAL*4 pvec(4),qvec(4),rvec(4)
21274 qvec(1)= cs*rvec(1)+sn*rvec(3)
21276 qvec(3)=-sn*rvec(1)+cs*rvec(3)
21281 SUBROUTINE rotor3(PHI,PVEC,QVEC)
21286 REAL*4 pvec(4),qvec(4),rvec(4)
21292 qvec(1)= cs*rvec(1)-sn*rvec(2)
21293 qvec(2)= sn*rvec(1)+cs*rvec(2)
21299 SUBROUTINE rotpol(THET,PHI,PP)
21312 SUBROUTINE rotpox(THET,PHI,PP)
21327 FUNCTION sigee(Q2,JNP)
21346 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
21347 + ,ampiz,ampi,amro,gamro,ama1,gama1
21348 + ,amk,amkz,amkst,gamkst
21350 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
21351 + ,ampiz,ampi,amro,gamro,ama1,gama1
21352 + ,amk,amkz,amkst,gamkst
21353 REAL*4 datsig(17,6)
21356 + 7.40,12.00,16.15,21.25,24.90,29.55,34.15,37.40,37.85,37.40,
21357 + 36.00,33.25,30.50,27.70,24.50,21.25,18.90,
21358 + 1.24, 2.50, 3.70, 5.40, 7.45,10.75,14.50,18.20,22.30,28.90,
21359 + 29.35,25.60,22.30,18.60,14.05,11.60, 9.10,
21362 + 9*.0,.65,1.25,2.20,3.15,5.00,5.75,7.80,8.25,
21365 DATA pi /3.141592653589793238462643/
21370 IF(jnp.EQ.4) jnpi=3
21371 IF(jnp.EQ.3) jnpi=4
21377 datsig(i,2) = datsig(i,2)/2.
21378 datsig(i,1) = datsig(i,1) + datsig(i,2)
21379 s = 1.025+(i-1)*.05
21384 IF(
t . gt.
s-ampi ) go to 20
21386 fact=(
t2/s2)**2*
sqrt((s2-
t2-ampi2)**2-4.*
t2*ampi2)/s2 *2.*
21388 fact = fact * (datsig(j,1)+datsig(j+1,1))
21389 10 datsig(i,3) = datsig(i,3) + fact
21390 20 datsig(i,3) = datsig(i,3) /(2*pi*fpi)**2
21391 datsig(i,4) = datsig(i,3)
21392 datsig(i,6) = datsig(i,5)
21395 10000
FORMAT(///1
x,
' EE SIGMA USED IN MULTIPI DECAYS'/
21401 sigee=datsig(1,jnpi)+
21402 + (datsig(2,jnpi)-datsig(1,jnpi))*(q-1.)/.05
21403 ELSEIF(q.LT.1.8)
THEN
21406 IF(q.LT.qmax) go to 50
21409 50
sigee=datsig(i,jnpi)+
21410 + (datsig(i+1,jnpi)-datsig(i,jnpi)) * (q-qmin)/.05
21411 ELSEIF(q.GT.1.8)
THEN
21412 sigee=datsig(17,jnpi)+
21413 + (datsig(17,jnpi)-datsig(16,jnpi)) * (q-1.8)/.05
21425 FUNCTION sigold(Q2,JNPI)
21444 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
21445 + ,ampiz,ampi,amro,gamro,ama1,gama1
21446 + ,amk,amkz,amkst,gamkst
21448 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
21449 + ,ampiz,ampi,amro,gamro,ama1,gama1
21450 + ,amk,amkz,amkst,gamkst
21451 REAL*4 datsig(17,4)
21454 + 7.40,12.00,16.15,21.25,24.90,29.55,34.15,37.40,37.85,37.40,
21455 + 36.00,33.25,30.50,27.70,24.50,21.25,18.90,
21456 + 1.24, 2.50, 3.70, 5.40, 7.45,10.75,14.50,18.20,22.30,28.90,
21457 + 29.35,25.60,22.30,18.60,14.05,11.60, 9.10,
21459 + 9*.0,.65,1.25,2.20,3.15,5.00,5.75,7.80,8.25/
21461 DATA pi /3.141592653589793238462643/
21469 datsig(i,2) = datsig(i,2)/2.
21470 datsig(i,1) = datsig(i,1) + datsig(i,2)
21471 s = 1.025+(i-1)*.05
21476 IF(
t . gt.
s-ampi ) go to 20
21478 fact=(
t2/s2)**2*
sqrt((s2-
t2-ampi2)**2-4.*
t2*ampi2)/s2 *2.*
21480 fact = fact * (datsig(j,1)+datsig(j+1,1))
21481 10 datsig(i,3) = datsig(i,3) + fact
21482 20 datsig(i,3) = datsig(i,3) /(2*pi*fpi)**2
21485 10000
FORMAT(///1
x,
' EE SIGMA USED IN MULTIPI DECAYS'/
21491 sigol=datsig(1,jnpi)+
21492 + (datsig(2,jnpi)-datsig(1,jnpi))*(q-1.)/.05
21493 ELSEIF(q.LT.1.8)
THEN
21496 IF(q.LT.qmax) go to 50
21499 50 sigol=datsig(i,jnpi)+
21500 + (datsig(i+1,jnpi)-datsig(i,jnpi)) * (q-qmin)/.05
21501 ELSEIF(q.GT.1.8)
THEN
21502 sigol=datsig(17,jnpi)+
21503 + (datsig(17,jnpi)-datsig(16,jnpi)) * (q-1.8)/.05
21505 IF(sigol.LT..0) sigol=0.
21507 sigol = sigol/(6.*pi**2*sig0)
21522 DATA pi /3.141592653589793238462643/
21525 costh=-1.+2.*rrr(1)
21526 sinth=
sqrt(1.-costh**2)
21527 x(1)=
r*sinth*
cos(2*pi*rrr(2))
21528 x(2)=
r*sinth*
sin(2*pi*rrr(2))
21539 REAL*8 r,
x(4),pi,costh,sinth
21541 DATA pi /3.141592653589793238462643d0/
21545 sinth=
sqrt(1 -costh**2)
21546 x(1)=
r*sinth*
cos(2*pi*rrr(2))
21547 x(2)=
r*sinth*
sin(2*pi*rrr(2))
21555 FUNCTION sqm2(ITDKRC,QP,XN,XA,XK,AK0,HV)
21568 IMPLICIT REAL*8(
a-h,o-
z)
21569 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
21570 + ,ampiz,ampi,amro,gamro,ama1,gama1
21571 + ,amk,amkz,amkst,gamkst
21573 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
21574 + ,ampiz,ampi,amro,gamro,ama1,gama1
21575 + ,amk,amkz,amkst,gamkst
21576 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
21577 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
21578 COMMON / qedprm /alfinv,alfpi,xk0
21579 REAL*8 alfinv,alfpi,xk0
21580 REAL*8 qp(4),xn(4),xa(4),xk(4)
21583 REAL*8 s0(3),rxa(3),rxk(3),rqp(3)
21584 DATA pi /3.141592653589793238462643d0/
21590 emass2=qp(4)**2-qp(1)**2-qp(2)**2-qp(3)**2
21598 rxa(i)=
r(4)*xa(4)-
r(1)*xa(1)-
r(2)*xa(2)-
r(3)*xa(3)
21600 rxk(i)=
r(4)*xk(4)-
r(1)*xk(1)-
r(2)*xk(2)-
r(3)*xk(3)
21601 rqp(i)=
r(4)*qp(4)-
r(1)*qp(1)-
r(2)*qp(2)-
r(3)*qp(3)
21603 qpxn=qp(4)*xn(4)-qp(1)*xn(1)-qp(2)*xn(2)-qp(3)*xn(3)
21604 qpxa=qp(4)*xa(4)-qp(1)*xa(1)-qp(2)*xa(2)-qp(3)*xa(3)
21605 qpxk=qp(4)*xk(4)-qp(1)*xk(1)-qp(2)*xk(2)-qp(3)*xk(3)
21607 xnxk=xn(4)*xk(4)-xn(1)*xk(1)-xn(2)*xk(2)-xn(3)*xk(3)
21608 xaxk=xa(4)*xk(4)-xa(1)*xk(1)-xa(2)*xk(2)-xa(3)*xk(3)
21617 b= 1+
x*(1+
z)/2+
z/2
21618 s1= qpxn*txa*( -emass2/qpxk**2*
a + 2*tqp/(qpxk*txk)*b-
21620 +qpxn/txk**2* ( tmass2*xaxk - txa*txk+ xaxk*txk) -
21621 +txa*txn/txk - qpxn/(qpxk*txk)* (tqp*xaxk-txk*qpxa)
21622 const4=256*pi/alphai*gf**2
21623 IF (itdkrc.EQ.0) const4=0d0
21626 s0(i) = qpxn*rxa(i)*(-emass2/qpxk**2*
a + 2*tqp/(qpxk*txk)*b-
21628 + qpxn/txk**2* (tmass2*xaxk - txa*rxk(i)+ xaxk*rxk(i))-
21629 + rxa(i)*txn/txk - qpxn/(qpxk*txk)*(rqp(i)*xaxk- rxk(i)*qpxa)
21630 20 hv(i)=s0(i)/s1-1.d0
21641 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
21642 + ,ampiz,ampi,amro,gamro,ama1,gama1
21643 + ,amk,amkz,amkst,gamkst
21645 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
21646 + ,ampiz,ampi,amro,gamro,ama1,gama1
21647 + ,amk,amkz,amkst,gamkst
21648 COMMON / idfc / idff
21651 COMMON /taupos / npa,npb
21652 dimension xpb1(4),xpb2(4),aqf1(4),aqf2(4)
21664 CALL
tralo4(1,aqf1,aqf1,am)
21665 CALL
tralo4(2,aqf2,aqf2,am)
21667 kfb1= 11*idff/iabs(idff)
21668 kfb2=-11*idff/iabs(idff)
21671 IF(aqf1(3).NE.0.0) xpb1(3)= aqf1(4)*aqf1(3)/abs(aqf1(3))
21674 IF(aqf2(3).NE.0.0) xpb2(3)= aqf2(4)*aqf2(3)/abs(aqf2(3))
21679 CALL
filhep( 1,3, kfb1,0,0,0,0,xpb1, amel,.true.)
21680 CALL
filhep( 2,3, kfb2,0,0,0,0,xpb2, amel,.true.)
21681 CALL
filhep(npa,1, idff,1,2,0,0,aqf1,amtau,.true.)
21682 CALL
filhep(npb,1,-idff,1,2,0,0,aqf2,amtau,.true.)
21697 COMMON / / blan(10000)
21698 COMMON / inout / inut,iout
21714 COMMON / taukle / bra1,brk0,brk0b,brks
21715 REAL*4 bra1,brk0,brk0b,brks
21716 COMMON / taubra / gamprt(30),jlist(30),nchan
21722 IF (i.LE.nchan)
THEN
21724 IF(i.EQ. 1) gamprt(i) = .0000
21725 IF(i.EQ. 2) gamprt(i) = .0000
21726 IF(i.EQ. 3) gamprt(i) = .0000
21727 IF(i.EQ. 4) gamprt(i) = .0000
21728 IF(i.EQ. 5) gamprt(i) = .0000
21729 IF(i.EQ. 6) gamprt(i) = .0000
21730 IF(i.EQ. 7) gamprt(i) = .0000
21731 IF(i.EQ. 8) gamprt(i) = 1.0000
21732 IF(i.EQ. 9) gamprt(i) = 1.0000
21733 IF(i.EQ.10) gamprt(i) = 1.0000
21734 IF(i.EQ.11) gamprt(i) = 1.0000
21735 IF(i.EQ.12) gamprt(i) = 1.0000
21736 IF(i.EQ.13) gamprt(i) = 1.0000
21737 IF(i.EQ.14) gamprt(i) = 1.0000
21738 IF(i.EQ.15) gamprt(i) = 1.0000
21739 IF(i.EQ.16) gamprt(i) = 1.0000
21740 IF(i.EQ.17) gamprt(i) = 1.0000
21741 IF(i.EQ.18) gamprt(i) = 1.0000
21742 IF(i.EQ.19) gamprt(i) = 1.0000
21765 IF (i.LE.nchan)
THEN
21767 IF(i.EQ. 1) gamprt(i) = .0000
21768 IF(i.EQ. 2) gamprt(i) = .0000
21769 IF(i.EQ. 3) gamprt(i) = .0000
21770 IF(i.EQ. 4) gamprt(i) = .0000
21771 IF(i.EQ. 5) gamprt(i) = .0000
21772 IF(i.EQ. 6) gamprt(i) = .0000
21773 IF(i.EQ. 7) gamprt(i) = .0000
21774 IF(i.EQ. 8) gamprt(i) = 1.0000
21775 IF(i.EQ. 9) gamprt(i) = 1.0000
21776 IF(i.EQ.10) gamprt(i) = 1.0000
21777 IF(i.EQ.11) gamprt(i) = 1.0000
21778 IF(i.EQ.12) gamprt(i) = 1.0000
21779 IF(i.EQ.13) gamprt(i) = 1.0000
21780 IF(i.EQ.14) gamprt(i) = 1.0000
21781 IF(i.EQ.15) gamprt(i) = 1.0000
21782 IF(i.EQ.16) gamprt(i) = 1.0000
21783 IF(i.EQ.17) gamprt(i) = 1.0000
21784 IF(i.EQ.18) gamprt(i) = 1.0000
21785 IF(i.EQ.19) gamprt(i) = 1.0000
21810 FUNCTION thb(ITDKRC,QP,XN,XA,AK0,HV)
21824 IMPLICIT REAL*8(
a-h,o-
z)
21825 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
21826 + ,ampiz,ampi,amro,gamro,ama1,gama1
21827 + ,amk,amkz,amkst,gamkst
21829 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
21830 + ,ampiz,ampi,amro,gamro,ama1,gama1
21831 + ,amk,amkz,amkst,gamkst
21832 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
21833 REAL*4 gfermi,gv,ga,ccabib,scabib,gamel
21834 COMMON / qedprm /alfinv,alfpi,xk0
21835 REAL*8 alfinv,alfpi,xk0
21836 dimension qp(4),xn(4),xa(4)
21839 REAL*8 rxa(3),rxn(3),rqp(3)
21840 REAL*8 bornpl(3),am3pol(3),xm3pol(3)
21841 DATA pi /3.141592653589793238462643d0/
21854 rxa(i)=
r(4)*xa(4)-
r(1)*xa(1)-
r(2)*xa(2)-
r(3)*xa(3)
21855 rxn(i)=
r(4)*xn(4)-
r(1)*xn(1)-
r(2)*xn(2)-
r(3)*xn(3)
21857 rqp(i)=
r(4)*qp(4)-
r(1)*qp(1)-
r(2)*qp(2)-
r(3)*qp(3)
21861 u3=
sqrt(qp(1)**2+qp(2)**2+qp(3)**2)/tmass
21863 w0=(xn(4)+xa(4))/tmass
21875 f0=2*u0/u3*(
dilog(1-(um*wm/(up*wp)))-
dilog(1-wm/wp) +
21876 +
dilog(1-um/up) -2*yu+ 2*
log(up)*(yw+yu) ) +
21877 +1/
y* ( 2*u3*yu + (1-eps2- 2*
y)*
log(eps) ) +
21878 + 2 - 4*(u0/u3*yu -1)*
log(2*al)
21879 fp= yu/(2*u3)*(1 + (1-eps2)/
y ) +
log(eps)/
y
21880 fm= yu/(2*u3)*(1 - (1-eps2)/
y ) -
log(eps)/
y
21883 qpxn=qp(4)*xn(4)-qp(1)*xn(1)-qp(2)*xn(2)-qp(3)*xn(3)
21884 qpxa=qp(4)*xa(4)-qp(1)*xa(1)-qp(2)*xa(2)-qp(3)*xa(3)
21885 xnxa=xn(4)*xa(4)-xn(1)*xa(1)-xn(2)*xa(2)-xn(3)*xa(3)
21890 const3=1/(2*alphai*pi)*64*gf**2
21891 IF (itdkrc.EQ.0) const3=0d0
21892 xm3= -( f0* qpxn*txa + fp*eps2* txn*txa +
21893 +fm* qpxn*qpxa +
f3* tmass2*xnxa )
21896 brak= (gv+ga)**2*tqp*xnxa+(gv-ga)**2*txa*qpxn
21897 + -(gv**2-ga**2)*tmass*amnuta*qpxa
21898 born= 32*(gfermi**2/2.)*brak
21900 xm3pol(i)= -( f0* qpxn*rxa(i) + fp*eps2* txn*rxa(i) +
21901 + fm* qpxn* (qpxa + (rxa(i)*tqp-txa*rqp(i))/tmass2 ) +
21902 +
f3* (tmass2*xnxa +txn*rxa(i) -rxn(i)*txa) )
21903 am3pol(i)=xm3pol(i)*const3
21906 + (gv+ga)**2*tmass*xnxa*qp(i)
21907 + -(gv-ga)**2*tmass*qpxn*xa(i)
21908 + +(gv**2-ga**2)*amnuta*txa*qp(i)
21909 + -(gv**2-ga**2)*amnuta*tqp*xa(i) )*
21910 + 32*(gfermi**2/2.)
21911 20 hv(i)=(bornpl(i)+am3pol(i))/(born+am3)-1.d0
21913 IF (
thb/born.LT.0.1d0)
THEN
21914 print *,
'ERROR IN THB, THB/BORN=',
thb/born
21921 SUBROUTINE tralo4(KTO,P,Q,AM)
21926 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
21927 * ,ampiz,ampi,amro,gamro,ama1,gama1
21928 * ,amk,amkz,amkst,gamkst
21930 REAL*4 amtau,amnuta,amel,amnue,ammu,amnumu
21931 * ,ampiz,ampi,amro,gamro,ama1,gama1
21932 * ,amk,amkz,amkst,gamkst
21935 etau=
sqrt(ptau**2+amtau**2)
21936 exe=(etau+ptau)/amtau
21937 IF(kto.EQ.2) exe=(etau-ptau)/amtau
21945 FUNCTION wigfor(S,XM,XGAM)
21947 wignor=cmplx(-xm**2,xm*xgam)
21948 wigfor=wignor/cmplx(
s-xm**2,xm*xgam)
21950 subroutine lframe(IFR, IPH)
subroutine dexnew(MODE, ISGN, POL, PNU, PAA, PNPI, JNPI)
subroutine pysspb(IPU1, IPU2)
subroutine lnstrf(X, Q2, XPQ)
subroutine gbspec(BEAM, IFLAV, RADIUS, SPEC)
COMPLEX function fpikm(W, XM1, XM2)
subroutine pystpr(X, Q2, XPPR)
subroutine getneu(IPNUM, NEUTYPE, VECT, GKIN, MESTYPE, G4MES, NEUFORCE, IMODE)
subroutine flipol(FLQ, FLG, FLM)
subroutine dexks(MODE, ISGN, POL, PNU, PKS, PKK, PPI, JKST)
G4ErrorMatrix dsum(const G4ErrorMatrix &, const G4ErrorMatrix &)
subroutine bostd3(EXE, PVEC, QVEC)
subroutine dphsro(DGAMT, HV, PN, PR, PIC, PIZ)
subroutine phooma(IFIRST, ILAST, POINTR)
DOUBLE PRECISION function riwfun(V)
subroutine lqcdpr(QG, QQB)
subroutine phlupa(IPOINT)
G4int nint(G4double number)
subroutine linit(LFILE, LEPIN, PLZ, PPZ, INTER)
real function phofac(MODE)
subroutine phochk(JFIRST)
function dqcdi(IPART, IP, XP, ZPMIN, ZPMAX)
subroutine dexro(MODE, ISGN, POL, PNU, PRO, PIC, PIZ)
subroutine dwlupi(KTO, ISGN, PPI, PNU)
COMPLEX function bwig(S, M, G)
subroutine ranmar(RVEC, ISEQ)
subroutine dekay(KTO, HX)
real function phocha(IDHEP)
subroutine gethneu(IPNUM, NEUTYPE, VECT, GKIN, MESTYPE, G4MES, NEUFORCE, IMODE)
subroutine dadmro(MODE, ISGN, HHV, PNU, PRO, PIC, PIZ)
subroutine rotor3(PHI, PVEC, QVEC)
REAL *4 function rlu(IDUMMY)
typedef int(XMLCALL *XML_NotStandaloneHandler)(void *userData)
complex function form3(MNUM, QQ, S1, SDWA)
subroutine dexay(KTO, POL)
subroutine gadap(A0, B0, F, EPS, SUM)
subroutine lmrazz(YNEW, PNEW)
subroutine gadap2(A0, B0, FL, FU, F, EPS, SUM)
subroutine lprikt(S, PT, PHI)
BasicVector3D< T > unit() const
subroutine phomak(IPPAR, NHEP0)
subroutine phobos(IP, PBOOS1, PBOOS2, FIRST, LAST)
real function photri(A, B, C)
G4double G4NeutronHPJENDLHEData::G4double result
function gadapf(X, A0, B0, F, EPS)
subroutine lu1ent(IP, KF, PE, THE, PHI)
complex function wigfor(S, XM, XGAM)
static c2_tan_p< float_type > & tan()
make a *new object
subroutine lscale(INFIN, QMAX)
double precision function phoan2(X, Y)
function sigold(Q2, JNPI)
subroutine dekay2(IMOD, HH, ISGN)
subroutine btocho2(VIN, PIN, PTX, PTY)
REAL *4 function phoran(IDUMMY)
subroutine rotor2(PH1, PVEC, QVEC)
subroutine lsigmx(NPAR, DERIV, DIFSIG, XF, IFLAG)
subroutine curr(MNUM, PIM1, PIM2, PIM3, PIM4, HADCUR)
subroutine dwlumu(KTO, ISGN, PNU, PWB, PMU, PNM)
subroutine dadmpi(MODE, ISGN, HV, PPI, PNU)
subroutine dadmmu(MODE, ISGN, HHV, PNU, PWB, Q1, Q2, PHX)
REAL function lmpint(PEXTI, I)
subroutine dphnpi(DGAMT, HVX, PNX, PRX, PPIX, JNPI)
subroutine dampaa(PT, PN, PIM1, PIM2, PIPL, AMPLIT, HV)
subroutine dwluro(KTO, ISGN, PNU, PRHO, PIC, PIZ)
subroutine dwluph(KTO, PHOT)
G4int mod(G4int a, G4int b)
subroutine luptdi(KFL, PX, PY)
REAL *4 function distrr(DUMMY)
subroutine orth(PO, P, PB)
subroutine dadmel(MODE, ISGN, HHV, PNU, PWB, Q1, Q2, PHX)
subroutine phodo(IP, NCHARB, NEUDAU)
function lqmcut(XP, ZP, AM1, AM2, AM3)
subroutine clnut(HJ, B, HV)
subroutine clvec(HJ, PN, PIV)
subroutine dadmkk(MODE, ISGN, HV, PKK, PNU)
complex function formom(XMAA, XMOM)
subroutine phoerr(IMES, TEXT, DATA)
subroutine tralo4(KTO, P, Q, AM)
subroutine lu2ent(IP, KF1, KF2, PECM)
subroutine dphsaa(DGAMT, HV, PN, PAA, PIM1, PIM2, PIPL, JAA)
subroutine forced_decay(NUFORCE, ISTATUS)
subroutine dexaa(MODE, ISGN, POL, PNU, PAA, PIM1, PIM2, PIPL, JAA)
subroutine lazimu(XP, ZP)
function dqcd(ICOSFI, IPART, IP, XP, ZP, Y)
subroutine dampog(PT, PN, PIM1, PIM2, PIPL, AMPLIT, HV)
function thb(ITDKRC, QP, XN, XA, AK0, HV)
subroutine rotod3(PH1, PVEC, QVEC)
subroutine dphsmu(DGAMX, HVX, XNX, PAAX, QPX, XAX, PHX)
COMPLEX function fpikmd(W, XM1, XM2)
subroutine flintg(CFLQ, CFLG, CFLM)
COMPLEX function bwigs(S, M, G)
subroutine dwrph(KTO, PHX)
real function phocor(MPASQR, MCHREN, ME)
subroutine phoro2(ANGLE, PVEC)
HepLorentzRotation & boost(double, double, double)
subroutine dphsrk(DGAMT, HV, PN, PR, PMULT, INUM)
subroutine dampry(ITDKRC, XK0DEC, XK, XA, QP, XN, AMPLIT, HV)
subroutine phoout(IP, BOOST, NHEP0)
subroutine filhep(N, IST, ID, JMO1, JMO2, JDA1, JDA2, P4, PINV, PHFLAG)
subroutine phoro3(ANGLE, PVEC)
subroutine rotpox(THET, PHI, PP)
function lunpik(ID, ISGN)
subroutine dwluaa(KTO, ISGN, PNU, PAA, PIM1, PIM2, PIPL, JAA)
subroutine lukfdi(KFL1, KFL2, KFL3, KF)
subroutine choice(MNUM, RR, ICHAN, PROB1, PROB2, PROB3, AMRX, GAMRX, AMRA, GAMRA, AMRB, GAMRB)
subroutine dekay1(IMOD, HH, ISGN)
subroutine dexay1(KTO, JAKIN, JAK, POL, ISGN)
subroutine dwlukk(KTO, ISGN, PKK, PNU)
subroutine phopre(IPARR, WT, NEUDAU, NCHARB)
T angle(const BasicVector3D< T > &v) const
subroutine phoin(IP, BOOST, NHEP0)
subroutine dph5pi(DGAMT, HV, PN, PAA, PMULT, JNPI)
subroutine phoene(MPASQR, MCHREN, BETA, IDENT)
subroutine title(NA, NB, NCA, NCB)
complex function form1(MNUM, QQ, S1, SDWA)
static c2_log_p< float_type > & log()
make a *new object
subroutine dadnew(MODE, ISGN, HV, PNU, PWB, PNPI, JNPI)
subroutine rotor1(PH1, PVEC, QVEC)
subroutine lmprin(IKODE, FVAL)
subroutine bostr3(EXE, PVEC, QVEC)
subroutine pystfu(KF, X, Q2, XPQ)
subroutine dwluel(KTO, ISGN, PNU, PWB, PEL, PNE)
subroutine lremh(IFLRO, IFLR, K2, Z)
subroutine dwlnew(KTO, ISGN, PNU, PWB, PNPI, MODE)
subroutine pyremm(IPU1, IPU2)
real function phospi(IDHEP)
subroutine damppk(MNUM, PT, PN, PIM1, PIM2, PIM3, AMPLIT, HV)
subroutine dexel(MODE, ISGN, POL, PNU, PWB, Q1, Q2, PH)
function sqm2(ITDKRC, QP, XN, XA, XK, AK0, HV)
static c2_sqrt_p< float_type > & sqrt()
make a *new object
subroutine dexpi(MODE, ISGN, POL, PPI, PNU)
subroutine lxp(XP, IFAIL)
subroutine dphsel(DGAMX, HVX, XNX, PAAX, QPX, XAX, PHX)
subroutine dadmaa(MODE, ISGN, HHV, PNU, PAA, PIM1, PIM2, PIPL, JAA)
subroutine lu3ent(IP, KF1, KF2, KF3, PECM, X1, X3)
const XML_Char int const XML_Char * value
complex function form2(MNUM, QQ, S1, SDWA)
DOUBLE PRECISION function dfun(NDIM, X)
subroutine dexkk(MODE, ISGN, POL, PKK, PNU)
subroutine dphtre(DGAMT, HV, PN, PAA, PIM1, AMPA, PIM2, AMPB, PIPL, AMP3, KEYT, MNUM)
double precision function phoan1(X, Y)
subroutine claxi(HJ, PN, PIA)
complex function form5(MNUM, QQ, S1, S2)
subroutine dwluks(KTO, ISGN, PNU, PKS, PKK, PPI, JKST)
subroutine lzp(XP, ZP, IFAIL)
subroutine lflav(IFL, IFLR)
COMPLEX function bwigm(S, M, G, XM1, XM2)
subroutine rotod2(PH1, PVEC, QVEC)
subroutine rotod1(PH1, PVEC, QVEC)
subroutine pyspla(KPART, KFLIN, KFLCH, KFLSP)
subroutine distr(IOP, NHKKH1, PO, IGENER)
subroutine dph4pi(DGAMT, HV, PN, PAA, PMULT, JNPI)
void print(const std::vector< T > &data)
subroutine dphspk(DGAMT, HV, PN, PAA, PNPI, JAA)
subroutine rotpol(THET, PHI, PP)
real function phint(IDUM)
subroutine gentable(LFILE, LEPIN, ENERGY_FIX, PPZ, INTERACTION)
subroutine luerrm(MERR, CHMESS)
subroutine dexmu(MODE, ISGN, POL, PNU, PWB, Q1, Q2, PH)
subroutine dadmks(MODE, ISGN, HHV, PNU, PKS, PKK, PPI, JKST)
static c2_cos_p< float_type > & cos()
make a *new object
subroutine dphsks(DGAMT, HV, PN, PKS, PKK, PPI, JKST)
float_type xmax() const
return the upper bound of the domain for this function as set by set_domain()
REAL *4 function rndmm(IDUMMY)
subroutine lurobo(THE, PHI, BEX, BEY, BEZ)
DOUBLE PRECISION function dbeta(X1, X2, BET)
subroutine dam4pi(MNUM, PT, PN, PIM1, PIM2, PIM3, PIM4, AMPLIT, HV)
subroutine luzdis(KFL1, KFL2, PR, Z)
float_type xmin() const
return the lower bound of the domain for this function as set by set_domain()
const XML_Char const XML_Char * data
subroutine lushow(IP1, IP2, QMAX)
subroutine prod5(P1, P2, P3, PIA)
complex function form4(MNUM, QQ, S1, S2, S3)
static c2_sin_p< float_type > & sin()
make a *new object
static c2_exp_p< float_type > & exp()
make a *new object
subroutine phobo3(ANGLE, PVEC)
COMPLEX function fpikmk(W, XM1, XM2)
subroutine drcmu(DGAMT, HV, PH, PAA, XA, QP, XN, IELMU)