11 IMPLICIT DOUBLE PRECISION(a-
h, o-
z)
15 parameter(ksusy1=1000000,ksusy2=2000000,ktechn=3000000,
16 &kexcit=4000000,kdimen=5000000)
18 parameter(maxnur=1000)
23 INTEGER nup,idprup,idup,istup,mothup,icolup
24 DOUBLE PRECISION xwgtup,scalup,aqedup,aqcdup,pup,vtimup,spinup
25 common/hepeup/nup,idprup,xwgtup,scalup,aqedup,aqcdup,idup(maxnup),
26 &istup(maxnup),mothup(2,maxnup),icolup(2,maxnup),pup(5,maxnup),
27 &vtimup(maxnup),spinup(maxnup)
31 common/pypart/
npart,npartd,ipart(maxnur),ptpart(maxnur)
33 common/
pydat1/mstu(200),paru(200),mstj(200),parj(200)
34 common/
pydat2/kchg(500,4),pmas(500,4),parf(2000),vckm(4,4)
35 common/
pydat3/mdcy(500,3),mdme(8000,2),brat(8000),kfdp(8000,5)
36 common/
pysubs/msel,mselpd,msub(500),kfin(2,-40:40),ckin(200)
39 common/
pyint2/iset(500),kfpr(500,2),coef(500,20),icol(40,4,2)
40 common/
pyint3/xsfx(2,-40:40),isig(1000,3),sigh(1000)
41 common/
pyint4/mwid(500),wids(500,5)
43 common/
pyssmt/zmix(4,4),umix(2,2),vmix(2,2),smz(4),smw(2),
44 &sfmix(16,4),zmixi(4,4),umixi(2,2),vmixi(2,2)
45 common/pytcsm/itcm(0:99),rtcm(0:99)
50 dimension wdtp(0:400),wdte(0:400,0:5),pmq(2),
z(2),cthe(2),
51 &
phi(2),kuppo(100),vintsv(41:66),ilab(100)
59 IF(isub.EQ.95.AND.
mint(57).GE.1)
THEN
67 IF((isub.GE.151.AND.isub.LE.160).OR.(isub.GE.171.AND.
70 IF(mod(isub-1,10).GE.5) ihigg=3
72 IF(isub.EQ.151.OR.isub.EQ.156) isub=3
73 IF(isub.EQ.152.OR.isub.EQ.157) isub=102
74 IF(isub.EQ.153.OR.isub.EQ.158) isub=103
75 IF(isub.EQ.171.OR.isub.EQ.176) isub=24
76 IF(isub.EQ.172.OR.isub.EQ.177) isub=26
77 IF(isub.EQ.173.OR.isub.EQ.178) isub=123
78 IF(isub.EQ.174.OR.isub.EQ.179) isub=124
79 IF(isub.EQ.181.OR.isub.EQ.186) isub=121
80 IF(isub.EQ.182.OR.isub.EQ.187) isub=122
81 IF(isub.EQ.183.OR.isub.EQ.188) isub=111
82 IF(isub.EQ.184.OR.isub.EQ.189) isub=112
83 IF(isub.EQ.185.OR.isub.EQ.190) isub=113
86 IF(isub.EQ.401.OR.isub.EQ.402) kfhigg=kfpr(isub,1)
89 IF(isub.GE.461.AND.isub.LE.479) isub=isub-40
94 IF(iset(isub).EQ.5) idoc=9
95 IF(iset(isub).EQ.11) idoc=4+nup
97 IF(idoc.GE.9.AND.iset(isub).LE.4) idoc=idoc+2
107 DO 120 jt=1,
mstp(126)+100
109 IF(
i.GT.mstu(4)) goto 120
133 IF(iset(isub).GE.3.AND.iset(isub).LE.5) shuser=shpr
139 p(
i,3)=0.5d0*shuser*(-1d0)**(jt-1)
157 IF(isub.EQ.12.OR.isub.EQ.53.OR.isub.EQ.54.OR.isub.EQ.58.OR.
158 &(isub.GE.135.AND.isub.LE.140).OR.isub.EQ.382.OR.isub.EQ.385)
THEN
160 IF(isub.EQ.58.OR.(isub.GE.137.AND.isub.LE.140)) iglga=22
161 CALL
pywidt(iglga,sh,wdtp,wdte)
162 180 rkfl=(wdte(0,1)+wdte(0,2)+wdte(0,4))*
pyr(0)
163 DO 190
i=1,mdcy(iglga,3)
164 kflf=kfdp(
i+mdcy(iglga,2)-1,1)
165 rkfl=rkfl-(wdte(
i,1)+wdte(
i,2)+wdte(
i,4))
166 IF(rkfl.LE.0d0) goto 200
169 IF((isub.EQ.53.OR.isub.EQ.385).AND.
mint(2).LE.2)
THEN
170 IF(kflf.GE.4) goto 180
171 ELSEIF((isub.EQ.53.OR.isub.EQ.385).AND.
mint(2).LE.4)
THEN
174 ELSEIF(isub.EQ.53.OR.isub.EQ.385)
THEN
177 ELSEIF(isub.EQ.382.AND.itcm(5).EQ.1.AND.iabs(
mint(15)).LE.2
178 & .AND.iabs(kflf).GE.3)
THEN
181 faccib=
vint(46)**2/rtcm(41)**4
182 IF(facqqb/(facqqb+faccib).LT.
pyr(0)) goto 180
183 ELSEIF(isub.EQ.382.AND.itcm(5).EQ.5.AND.
mint(2).EQ.2)
THEN
186 ELSEIF(isub.EQ.382.AND.itcm(5).EQ.5.AND.
mint(2).EQ.1)
THEN
187 IF(kflf.EQ.5) goto 180
188 ELSEIF(isub.EQ.54.OR.isub.EQ.135.OR.isub.EQ.136)
THEN
189 IF((kchg(
pycomp(kflf),1)/2d0)**2.LT.
pyr(0)) goto 180
190 ELSEIF(isub.EQ.58.OR.(isub.GE.137.AND.isub.LE.140))
THEN
191 IF((kchg(
pycomp(kflf),1)/3d0)**2.LT.
pyr(0)) goto 180
202 kcs=isign(1,
mint(15))
204 IF(iset(isub).EQ.11)
THEN
208 IF(istup(iup).LT.1.OR.istup(iup).GT.3)
THEN
209 ELSEIF(nup.EQ.5.AND.iup.GE.4.AND.mothup(1,4).EQ.3)
THEN
210 mint(21+iup)=idup(iup)
211 ELSEIF(istup(iup).EQ.1.AND.(istup(mothup(1,iup)).EQ.2.OR.
212 & istup(mothup(1,iup)).EQ.3).AND.idup(mothup(1,iup)).NE.0)
THEN
213 ELSEIF(idup(iup).EQ.0)
THEN
220 ELSEIF(isub.LE.10)
THEN
225 ELSEIF(isub.EQ.2)
THEN
227 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
228 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
229 kfres=isign(24,kch1+kch2)
231 ELSEIF(isub.EQ.3)
THEN
235 ELSEIF(isub.EQ.4)
THEN
238 ELSEIF(isub.EQ.5)
THEN
245 220 jt=int(1.5d0+
pyr(0))
246 zmin=2d0*pmq(jt)/shpr
247 zmax=1d0-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/
248 & (shpr*(shpr-pmq(3-jt)))
249 zmax=min(1d0-xh,zmax)
250 z(jt)=zmin+(zmax-zmin)*
pyr(0)
251 IF(-1d0+(1d0+xh)/(1d0-
z(jt))-xh/(1d0-
z(jt))**2.LT.
252 & (1d0-xh)**2/(4d0*xh)*
pyr(0)) goto 220
253 sqc1=1d0-4d0*pmq(jt)**2/(
z(jt)**2*shp)
254 IF(sqc1.LT.1d-8) goto 220
256 c2=1d0+2d0*(pmas(23,1)**2-pmq(jt)**2)/(
z(jt)*shp)
257 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
258 cthe(jt)=min(1d0,
max(-1d0,cthe(jt)))
259 z(3-jt)=1d0-xh/(1d0-
z(jt))
260 sqc1=1d0-4d0*pmq(3-jt)**2/(
z(3-jt)**2*shp)
261 IF(sqc1.LT.1d-8) goto 220
263 c2=1d0+2d0*(pmas(23,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
264 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
265 cthe(3-jt)=min(1d0,
max(-1d0,cthe(3-jt)))
268 ang=cthe(1)*cthe(2)-sqrt(1d0-cthe(1)**2)*
269 & sqrt(1d0-cthe(2)**2)*cphi
271 z2=ang*sqrt(
z(jt)**2-4d0*pmq(jt)**2/shp)
272 z3=1d0-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
273 z(3-jt)=2d0/(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
275 zmin=2d0*pmq(3-jt)/shpr
276 zmax=1d0-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
277 zmax=min(1d0-xh,zmax)
278 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 220
282 ELSEIF(isub.EQ.6)
THEN
285 ELSEIF(isub.EQ.7)
THEN
288 ELSEIF(isub.EQ.8)
THEN
300 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 240
301 mint(20+jt)=isign(ib,
i)
302 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
303 IF(rvckm.LE.0d0) goto 250
306 ib=2*((ia+1)/2)-1+mod(ia,2)
307 mint(20+jt)=isign(ib,
i)
312 zmin=2d0*pmq(jt)/shpr
313 zmax=1d0-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/
314 & (shpr*(shpr-pmq(3-jt)))
315 zmax=min(1d0-xh,zmax)
316 IF(zmin.GE.zmax) goto 230
317 z(jt)=zmin+(zmax-zmin)*
pyr(0)
318 IF(-1d0+(1d0+xh)/(1d0-
z(jt))-xh/(1d0-
z(jt))**2.LT.
319 & (1d0-xh)**2/(4d0*xh)*
pyr(0)) goto 230
320 sqc1=1d0-4d0*pmq(jt)**2/(
z(jt)**2*shp)
321 IF(sqc1.LT.1d-8) goto 230
323 c2=1d0+2d0*(pmas(24,1)**2-pmq(jt)**2)/(
z(jt)*shp)
324 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
325 cthe(jt)=min(1d0,
max(-1d0,cthe(jt)))
326 z(3-jt)=1d0-xh/(1d0-
z(jt))
327 sqc1=1d0-4d0*pmq(3-jt)**2/(
z(3-jt)**2*shp)
328 IF(sqc1.LT.1d-8) goto 230
330 c2=1d0+2d0*(pmas(24,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
331 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
332 cthe(3-jt)=min(1d0,
max(-1d0,cthe(3-jt)))
335 ang=cthe(1)*cthe(2)-sqrt(1d0-cthe(1)**2)*
336 & sqrt(1d0-cthe(2)**2)*cphi
338 z2=ang*sqrt(
z(jt)**2-4d0*pmq(jt)**2/shp)
339 z3=1d0-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
340 z(3-jt)=2d0/(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
342 zmin=2d0*pmq(3-jt)/shpr
343 zmax=1d0-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
344 zmax=min(1d0-xh,zmax)
345 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 230
349 ELSEIF(isub.EQ.10)
THEN
351 IF(
mint(2).EQ.1)
THEN
364 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 270
365 mint(20+jt)=isign(ib,
i)
366 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
367 IF(rvckm.LE.0d0) goto 280
370 ib=2*((ia+1)/2)-1+mod(ia,2)
371 mint(20+jt)=isign(ib,
i)
378 ELSEIF(isub.LE.20)
THEN
382 IF(
mint(15)*
mint(16).LT.0) kcc=kcc+2
384 ELSEIF(isub.EQ.12)
THEN
390 ELSEIF(isub.EQ.13)
THEN
396 ELSEIF(isub.EQ.14)
THEN
398 IF(
pyr(0).GT.0.5d0) js=2
403 ELSEIF(isub.EQ.15)
THEN
405 IF(
pyr(0).GT.0.5d0) js=2
410 ELSEIF(isub.EQ.16)
THEN
412 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
413 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
414 IF(
mint(15)*(kch1+kch2).LT.0) js=2
416 mint(23-js)=isign(24,kch1+kch2)
419 ELSEIF(isub.EQ.17)
THEN
421 IF(
pyr(0).GT.0.5d0) js=2
426 ELSEIF(isub.EQ.18)
THEN
431 ELSEIF(isub.EQ.19)
THEN
433 IF(
pyr(0).GT.0.5d0) js=2
437 ELSEIF(isub.EQ.20)
THEN
440 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
441 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
442 IF(
mint(15)*(kch1+kch2).LT.0) js=2
444 mint(23-js)=isign(24,kch1+kch2)
447 ELSEIF(isub.LE.30)
THEN
450 IF(
pyr(0).GT.0.5d0) js=2
454 ELSEIF(isub.EQ.22)
THEN
459 ELSEIF(isub.EQ.23)
THEN
461 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
462 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
463 IF(
mint(15)*(kch1+kch2).LT.0) js=2
465 mint(23-js)=isign(24,kch1+kch2)
467 ELSEIF(isub.EQ.24)
THEN
469 IF(
pyr(0).GT.0.5d0) js=2
473 ELSEIF(isub.EQ.25)
THEN
478 ELSEIF(isub.EQ.26)
THEN
481 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
482 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
483 IF(
mint(15)*(kch1+kch2).GT.0) js=2
484 mint(20+js)=isign(24,kch1+kch2)
487 ELSEIF(isub.EQ.27)
THEN
490 ELSEIF(isub.EQ.28)
THEN
492 IF(
mint(15).EQ.21) js=2
494 IF(
mint(15).EQ.21) kcc=kcc+2
495 IF(
mint(15).NE.21) kcs=isign(1,
mint(15))
496 IF(
mint(16).NE.21) kcs=isign(1,
mint(16))
498 ELSEIF(isub.EQ.29)
THEN
500 IF(
mint(15).EQ.21) js=2
503 kcs=isign(1,
mint(14+js))
505 ELSEIF(isub.EQ.30)
THEN
507 IF(
mint(15).EQ.21) js=2
510 kcs=isign(1,
mint(14+js))
513 ELSEIF(isub.LE.40)
THEN
516 IF(
mint(15).EQ.21) js=2
519 mint(23-js)=isign(24,kchg(ia,1)*
i)
525 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 290
526 mint(20+js)=isign(ib,
i)
527 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
528 IF(rvckm.LE.0d0) goto 300
531 kcs=isign(1,
mint(14+js))
533 ELSEIF(isub.EQ.32)
THEN
535 IF(
mint(15).EQ.21) js=2
538 kcs=isign(1,
mint(14+js))
540 ELSEIF(isub.EQ.33)
THEN
542 IF(
mint(15).EQ.22) js=2
545 kcs=isign(1,
mint(14+js))
547 ELSEIF(isub.EQ.34)
THEN
549 IF(
mint(15).EQ.22) js=2
551 kcs=isign(1,
mint(14+js))
553 ELSEIF(isub.EQ.35)
THEN
555 IF(
mint(15).EQ.22) js=2
559 ELSEIF(isub.EQ.36)
THEN
561 IF(
mint(15).EQ.22) js=2
564 mint(23-js)=isign(24,kchg(ia,1)*
i)
571 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 310
572 mint(20+js)=isign(ib,
i)
573 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
574 IF(rvckm.LE.0d0) goto 320
577 ib=2*((ia+1)/2)-1+mod(ia,2)
578 mint(20+js)=isign(ib,
i)
582 ELSEIF(isub.EQ.37)
THEN
585 ELSEIF(isub.EQ.38)
THEN
588 ELSEIF(isub.EQ.39)
THEN
591 ELSEIF(isub.EQ.40)
THEN
595 ELSEIF(isub.LE.50)
THEN
599 ELSEIF(isub.EQ.42)
THEN
602 ELSEIF(isub.EQ.43)
THEN
605 ELSEIF(isub.EQ.44)
THEN
608 ELSEIF(isub.EQ.45)
THEN
611 ELSEIF(isub.EQ.46)
THEN
614 ELSEIF(isub.EQ.47)
THEN
617 ELSEIF(isub.EQ.48)
THEN
620 ELSEIF(isub.EQ.49)
THEN
623 ELSEIF(isub.EQ.50)
THEN
627 ELSEIF(isub.LE.60)
THEN
631 ELSEIF(isub.EQ.52)
THEN
634 ELSEIF(isub.EQ.53)
THEN
636 kcs=(-1)**int(1.5d0+
pyr(0))
637 mint(21)=isign(kflf,kcs)
641 ELSEIF(isub.EQ.54)
THEN
643 kcs=(-1)**int(1.5d0+
pyr(0))
644 mint(21)=isign(kflf,kcs)
647 IF(
mint(16).EQ.21) kcc=28
649 ELSEIF(isub.EQ.55)
THEN
652 ELSEIF(isub.EQ.56)
THEN
655 ELSEIF(isub.EQ.57)
THEN
658 ELSEIF(isub.EQ.58)
THEN
660 kcs=(-1)**int(1.5d0+
pyr(0))
661 mint(21)=isign(kflf,kcs)
665 ELSEIF(isub.EQ.59)
THEN
668 ELSEIF(isub.EQ.60)
THEN
672 ELSEIF(isub.LE.70)
THEN
676 ELSEIF(isub.EQ.62)
THEN
679 ELSEIF(isub.EQ.63)
THEN
682 ELSEIF(isub.EQ.64)
THEN
685 ELSEIF(isub.EQ.65)
THEN
688 ELSEIF(isub.EQ.66)
THEN
691 ELSEIF(isub.EQ.67)
THEN
694 ELSEIF(isub.EQ.68)
THEN
697 kcs=(-1)**int(1.5d0+
pyr(0))
699 ELSEIF(isub.EQ.69)
THEN
705 ELSEIF(isub.EQ.70)
THEN
712 ELSEIF(isub.LE.80)
THEN
713 IF(isub.EQ.71.OR.isub.EQ.72)
THEN
720 330 jt=int(1.5d0+
pyr(0))
721 zmin=2d0*pmq(jt)/shpr
722 zmax=1d0-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/
723 & (shpr*(shpr-pmq(3-jt)))
724 zmax=min(1d0-xh,zmax)
725 z(jt)=zmin+(zmax-zmin)*
pyr(0)
726 IF(-1d0+(1d0+xh)/(1d0-
z(jt))-xh/(1d0-
z(jt))**2.LT.
727 & (1d0-xh)**2/(4d0*xh)*
pyr(0)) goto 330
728 sqc1=1d0-4d0*pmq(jt)**2/(
z(jt)**2*shp)
729 IF(sqc1.LT.1d-8) goto 330
731 c2=1d0+2d0*(pmas(23,1)**2-pmq(jt)**2)/(
z(jt)*shp)
732 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
733 cthe(jt)=min(1d0,
max(-1d0,cthe(jt)))
734 z(3-jt)=1d0-xh/(1d0-
z(jt))
735 sqc1=1d0-4d0*pmq(3-jt)**2/(
z(3-jt)**2*shp)
736 IF(sqc1.LT.1d-8) goto 330
738 c2=1d0+2d0*(pmas(23,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
739 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
740 cthe(3-jt)=min(1d0,
max(-1d0,cthe(3-jt)))
743 ang=cthe(1)*cthe(2)-sqrt(1d0-cthe(1)**2)*
744 & sqrt(1d0-cthe(2)**2)*cphi
746 z2=ang*sqrt(
z(jt)**2-4d0*pmq(jt)**2/shp)
747 z3=1d0-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
748 z(3-jt)=2d0/(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
750 zmin=2d0*pmq(3-jt)/shpr
751 zmax=1d0-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
752 zmax=min(1d0-xh,zmax)
753 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 330
756 ELSEIF(isub.EQ.73)
THEN
769 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 350
770 mint(20+jt)=isign(ib,
i)
771 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
772 IF(rvckm.LE.0d0) goto 360
775 ib=2*((ia+1)/2)-1+mod(ia,2)
776 mint(20+jt)=isign(ib,
i)
782 zmin=2d0*pmq(jt)/shpr
783 zmax=1d0-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/
784 & (shpr*(shpr-pmq(3-jt)))
785 zmax=min(1d0-xh,zmax)
786 IF(zmin.GE.zmax) goto 340
787 z(jt)=zmin+(zmax-zmin)*
pyr(0)
788 IF(-1d0+(1d0+xh)/(1d0-
z(jt))-xh/(1d0-
z(jt))**2.LT.
789 & (1d0-xh)**2/(4d0*xh)*
pyr(0)) goto 340
790 sqc1=1d0-4d0*pmq(jt)**2/(
z(jt)**2*shp)
791 IF(sqc1.LT.1d-8) goto 340
793 c2=1d0+2d0*(pmas(23,1)**2-pmq(jt)**2)/(
z(jt)*shp)
794 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
795 cthe(jt)=min(1d0,
max(-1d0,cthe(jt)))
796 z(3-jt)=1d0-xh/(1d0-
z(jt))
797 sqc1=1d0-4d0*pmq(3-jt)**2/(
z(3-jt)**2*shp)
798 IF(sqc1.LT.1d-8) goto 340
800 c2=1d0+2d0*(pmas(23,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
801 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
802 cthe(3-jt)=min(1d0,
max(-1d0,cthe(3-jt)))
805 ang=cthe(1)*cthe(2)-sqrt(1d0-cthe(1)**2)*
806 & sqrt(1d0-cthe(2)**2)*cphi
808 z2=ang*sqrt(
z(jt)**2-4d0*pmq(jt)**2/shp)
809 z3=1d0-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
810 z(3-jt)=2d0/(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
812 zmin=2d0*pmq(3-jt)/shpr
813 zmax=1d0-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
814 zmax=min(1d0-xh,zmax)
815 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 340
818 ELSEIF(isub.EQ.74)
THEN
821 ELSEIF(isub.EQ.75)
THEN
824 ELSEIF(isub.EQ.76.OR.isub.EQ.77)
THEN
836 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 380
837 mint(20+jt)=isign(ib,
i)
838 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
839 IF(rvckm.LE.0d0) goto 390
842 ib=2*((ia+1)/2)-1+mod(ia,2)
843 mint(20+jt)=isign(ib,
i)
848 zmin=2d0*pmq(jt)/shpr
849 zmax=1d0-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/
850 & (shpr*(shpr-pmq(3-jt)))
851 zmax=min(1d0-xh,zmax)
852 IF(zmin.GE.zmax) goto 370
853 z(jt)=zmin+(zmax-zmin)*
pyr(0)
854 IF(-1d0+(1d0+xh)/(1d0-
z(jt))-xh/(1d0-
z(jt))**2.LT.
855 & (1d0-xh)**2/(4d0*xh)*
pyr(0)) goto 370
856 sqc1=1d0-4d0*pmq(jt)**2/(
z(jt)**2*shp)
857 IF(sqc1.LT.1d-8) goto 370
859 c2=1d0+2d0*(pmas(24,1)**2-pmq(jt)**2)/(
z(jt)*shp)
860 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
861 cthe(jt)=min(1d0,
max(-1d0,cthe(jt)))
862 z(3-jt)=1d0-xh/(1d0-
z(jt))
863 sqc1=1d0-4d0*pmq(3-jt)**2/(
z(3-jt)**2*shp)
864 IF(sqc1.LT.1d-8) goto 370
866 c2=1d0+2d0*(pmas(24,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
867 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2d0*
pyr(0)-1d0)*c1))/c1
868 cthe(3-jt)=min(1d0,
max(-1d0,cthe(3-jt)))
871 ang=cthe(1)*cthe(2)-sqrt(1d0-cthe(1)**2)*
872 & sqrt(1d0-cthe(2)**2)*cphi
874 z2=ang*sqrt(
z(jt)**2-4d0*pmq(jt)**2/shp)
875 z3=1d0-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
876 z(3-jt)=2d0/(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
878 zmin=2d0*pmq(3-jt)/shpr
879 zmax=1d0-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
880 zmax=min(1d0-xh,zmax)
881 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 370
884 ELSEIF(isub.EQ.78)
THEN
887 ELSEIF(isub.EQ.79)
THEN
890 ELSEIF(isub.EQ.80)
THEN
892 IF(
mint(15).EQ.22) js=2
895 mint(23-js)=isign(211,kchg(ia,1)*
i)
897 mint(20+js)=isign(ib,
i)
901 ELSEIF(isub.LE.90)
THEN
908 ELSEIF(isub.EQ.82)
THEN
910 kcs=(-1)**int(1.5d0+
pyr(0))
915 ELSEIF(isub.EQ.83)
THEN
920 IF(kfaold.GT.10)
THEN
921 kfanew=kfaold+2*mod(kfaold,2)-1
924 ipm=(5-isign(1,kfold))/2
925 kfanew=-mod(kfaold+1,2)
927 idc=mdcy(kfaold,2)+(kfanew+1)/2+2
928 IF(mdme(idc,1).EQ.1.OR.mdme(idc,1).EQ.ipm)
THEN
929 IF(mod(kfaold,2).EQ.0) rckm=rckm-
930 & vckm(kfaold/2,(kfanew+1)/2)
931 IF(mod(kfaold,2).EQ.1) rckm=rckm-
932 & vckm(kfanew/2,(kfaold+1)/2)
934 IF(kfanew.LE.6.AND.rckm.GT.0d0) goto 410
936 IF(
mint(2).EQ.1)
THEN
946 ELSEIF(isub.EQ.84)
THEN
948 kcs=(-1)**int(1.5d0+
pyr(0))
952 IF(
mint(16).EQ.21) kcc=28
954 ELSEIF(isub.EQ.85)
THEN
956 kcs=(-1)**int(1.5d0+
pyr(0))
961 ELSEIF(isub.GE.86.AND.isub.LE.89)
THEN
963 mint(21)=kfpr(isub,1)
964 mint(22)=kfpr(isub,2)
966 kcs=(-1)**int(1.5d0+
pyr(0))
969 ELSEIF(isub.LE.100)
THEN
973 kcs=(-1)**int(1.5d0+
pyr(0))
975 ELSEIF(isub.EQ.96)
THEN
979 ELSEIF(isub.LE.110)
THEN
985 ELSEIF(isub.EQ.102)
THEN
990 ELSEIF(isub.EQ.103)
THEN
995 ELSEIF(isub.EQ.104.OR.isub.EQ.105)
THEN
1000 ELSEIF(isub.EQ.106)
THEN
1002 mint(21)=kfpr(isub,1)
1003 mint(22)=kfpr(isub,2)
1006 ELSEIF(isub.EQ.107)
THEN
1008 mint(21)=kfpr(isub,1)
1009 mint(22)=kfpr(isub,2)
1011 IF(
mint(16).EQ.22) kcc=33
1013 ELSEIF(isub.EQ.108)
THEN
1015 mint(21)=kfpr(isub,1)
1016 mint(22)=kfpr(isub,2)
1018 ELSEIF(isub.EQ.110)
THEN
1020 IF(
pyr(0).GT.0.5d0) js=2
1025 ELSEIF(isub.LE.120)
THEN
1026 IF(isub.EQ.111)
THEN
1028 IF(
pyr(0).GT.0.5d0) js=2
1033 ELSEIF(isub.EQ.112)
THEN
1035 IF(
mint(15).EQ.21) js=2
1038 kcs=isign(1,
mint(14+js))
1040 ELSEIF(isub.EQ.113)
THEN
1042 IF(
pyr(0).GT.0.5d0) js=2
1045 kcs=(-1)**int(1.5d0+
pyr(0))
1047 ELSEIF(isub.EQ.114)
THEN
1049 IF(
pyr(0).GT.0.5d0) js=2
1054 ELSEIF(isub.EQ.115)
THEN
1056 IF(
pyr(0).GT.0.5d0) js=2
1059 kcs=(-1)**int(1.5d0+
pyr(0))
1061 ELSEIF(isub.EQ.116)
THEN
1064 ELSEIF(isub.EQ.117)
THEN
1067 ELSEIF(isub.EQ.118)
THEN
1071 ELSEIF(isub.LE.140)
THEN
1072 IF(isub.EQ.121)
THEN
1074 kcs=(-1)**int(1.5d0+
pyr(0))
1075 mint(21)=isign(kfpr(isubsv,2),kcs)
1077 kcc=11+int(0.5d0+
pyr(0))
1080 ELSEIF(isub.EQ.122)
THEN
1082 mint(21)=isign(kfpr(isubsv,2),
mint(15))
1087 ELSEIF(isub.EQ.123)
THEN
1093 ELSEIF(isub.EQ.124)
THEN
1103 ipm=(5-isign(1,
i))/2
1105 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 420
1106 mint(20+jt)=isign(ib,
i)
1107 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
1108 IF(rvckm.LE.0d0) goto 430
1111 ib=2*((ia+1)/2)-1+mod(ia,2)
1112 mint(20+jt)=isign(ib,
i)
1118 ELSEIF(isub.EQ.131.OR.isub.EQ.132)
THEN
1120 IF(
mint(15).EQ.22) js=2
1123 kcs=isign(1,
mint(14+js))
1125 ELSEIF(isub.EQ.133.OR.isub.EQ.134)
THEN
1127 IF(
mint(15).EQ.22) js=2
1129 kcs=isign(1,
mint(14+js))
1131 ELSEIF(isub.EQ.135.OR.isub.EQ.136)
THEN
1133 kcs=(-1)**int(1.5d0+
pyr(0))
1134 mint(21)=isign(kflf,kcs)
1137 IF(
mint(16).EQ.21) kcc=28
1139 ELSEIF(isub.GE.137.AND.isub.LE.140)
THEN
1141 kcs=(-1)**int(1.5d0+
pyr(0))
1142 mint(21)=isign(kflf,kcs)
1148 ELSEIF(isub.LE.160)
THEN
1149 IF(isub.EQ.141)
THEN
1153 ELSEIF(isub.EQ.142)
THEN
1155 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1156 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1157 kfres=isign(34,kch1+kch2)
1159 ELSEIF(isub.EQ.143)
THEN
1161 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1162 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1163 kfres=isign(37,kch1+kch2)
1165 ELSEIF(isub.EQ.144)
THEN
1169 ELSEIF(isub.EQ.145)
THEN
1171 IF(iabs(
mint(16)).LE.8) js=2
1172 kfres=isign(42,
mint(14+js))
1174 kcs=isign(1,
mint(14+js))
1176 ELSEIF(isub.EQ.146)
THEN
1178 IF(
mint(15).EQ.22) js=2
1179 kfres=isign(kfpr(isub,1),
mint(14+js))
1182 ELSEIF(isub.EQ.147.OR.isub.EQ.148)
THEN
1184 IF(
mint(15).EQ.21) js=2
1185 kfres=isign(kfpr(isub,1),
mint(14+js))
1187 kcs=isign(1,
mint(14+js))
1189 ELSEIF(isub.EQ.149)
THEN
1193 kcs=(-1)**int(1.5d0+
pyr(0))
1196 ELSEIF(isub.LE.200)
THEN
1197 IF(isub.EQ.161)
THEN
1199 IF(
mint(15).EQ.21) js=2
1202 mint(23-js)=isign(37,kchg(ia,1)*
i)
1203 ib=ia+mod(ia,2)-mod(ia+1,2)
1204 mint(20+js)=isign(ib,
i)
1206 kcs=isign(1,
mint(14+js))
1208 ELSEIF(isub.EQ.162)
THEN
1210 IF(
mint(15).EQ.21) js=2
1212 kflql=kfdp(mdcy(42,2),2)
1213 mint(23-js)=-isign(kflql,
mint(14+js))
1215 kcs=isign(1,
mint(14+js))
1217 ELSEIF(isub.EQ.163)
THEN
1219 kcs=(-1)**int(1.5d0+
pyr(0))
1220 mint(21)=isign(42,kcs)
1224 ELSEIF(isub.EQ.164)
THEN
1230 ELSEIF(isub.EQ.165)
THEN
1232 mint(21)=isign(kfpr(isub,1),
mint(15))
1235 ELSEIF(isub.EQ.166)
THEN
1237 IF(mod(
mint(15),2).EQ.0)
THEN
1238 mint(21)=isign(kfpr(isub,1)+1,
mint(15))
1239 mint(22)=isign(kfpr(isub,1),
mint(16))
1241 mint(21)=isign(kfpr(isub,1),
mint(15))
1242 mint(22)=isign(kfpr(isub,1)+1,
mint(16))
1245 ELSEIF(isub.EQ.167.OR.isub.EQ.168)
THEN
1248 kfqexc=mod(kfqstr,kexcit)
1250 mint(20+js)=isign(kfqstr,
mint(14+js))
1251 IF(iabs(
mint(15)).NE.kfqexc.AND.iabs(
mint(16)).NE.kfqexc)
1252 &
mint(23-js)=isign(kfqexc,
mint(17-js))
1256 ELSEIF(isub.EQ.169)
THEN
1259 kfqexc=mod(kfqstr,kexcit)
1261 mint(20+js)=isign(kfqstr,
mint(14+js))
1262 mint(23-js)=isign(kfqexc,
mint(17-js))
1265 ELSEIF(isub.EQ.191)
THEN
1269 ELSEIF(isub.EQ.192)
THEN
1271 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1272 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1273 kfres=isign(ktechn+213,kch1+kch2)
1275 ELSEIF(isub.EQ.193)
THEN
1279 ELSEIF(isub.EQ.194)
THEN
1282 mint(21)=isign(kfpr(isub,1),
mint(15))
1285 ELSEIF(isub.EQ.195)
THEN
1289 IF(mod(
mint(15),2).EQ.0)
THEN
1290 mint(21)=isign(kfpr(isub,1)+1,
mint(15))
1291 mint(22)=isign(kfpr(isub,1),
mint(16))
1293 mint(21)=isign(kfpr(isub,1),
mint(15))
1294 mint(22)=isign(kfpr(isub,1)+1,
mint(16))
1299 ELSEIF(isub.LE.215)
THEN
1300 IF(isub.EQ.201)
THEN
1302 mint(21)=isign(ksusy1+11,kcs)
1305 ELSEIF(isub.EQ.202)
THEN
1307 mint(21)=isign(ksusy2+11,kcs)
1310 ELSEIF(isub.EQ.203)
THEN
1312 IF(
mint(15).LT.0) js=2
1313 IF(
mint(2).EQ.1)
THEN
1314 mint(20+js)=kfpr(isub,1)
1315 mint(23-js)=-kfpr(isub,2)
1317 mint(20+js)=-kfpr(isub,1)
1318 mint(23-js)=kfpr(isub,2)
1321 ELSEIF(isub.EQ.204)
THEN
1323 mint(21)=isign(ksusy1+13,kcs)
1326 ELSEIF(isub.EQ.205)
THEN
1328 mint(21)=isign(ksusy2+13,kcs)
1331 ELSEIF(isub.EQ.206)
THEN
1333 IF(
mint(15).LT.0) js=2
1334 IF(
mint(2).EQ.1)
THEN
1335 mint(20+js)=kfpr(isub,1)
1336 mint(23-js)=-kfpr(isub,2)
1338 mint(20+js)=-kfpr(isub,1)
1339 mint(23-js)=kfpr(isub,2)
1342 ELSEIF(isub.EQ.207)
THEN
1344 mint(21)=isign(ksusy1+15,kcs)
1347 ELSEIF(isub.EQ.208)
THEN
1349 mint(21)=isign(ksusy2+15,kcs)
1352 ELSEIF(isub.EQ.209)
THEN
1354 IF(
mint(15).LT.0) js=2
1355 IF(
mint(2).EQ.1)
THEN
1356 mint(20+js)=kfpr(isub,1)
1357 mint(23-js)=-kfpr(isub,2)
1359 mint(20+js)=-kfpr(isub,1)
1360 mint(23-js)=kfpr(isub,2)
1363 ELSEIF(isub.EQ.210)
THEN
1365 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1366 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1367 mint(21)=-isign(kfpr(isub,1),kch1+kch2)
1368 mint(22)=isign(kfpr(isub,2),kch1+kch2)
1370 ELSEIF(isub.EQ.211)
THEN
1372 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1373 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1374 mint(21)=-isign(ksusy1+15,kch1+kch2)
1375 mint(22)=isign(ksusy1+16,kch1+kch2)
1377 ELSEIF(isub.EQ.212)
THEN
1379 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1380 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1381 mint(21)=-isign(ksusy2+15,kch1+kch2)
1382 mint(22)=isign(ksusy1+16,kch1+kch2)
1384 ELSEIF(isub.EQ.213)
THEN
1386 mint(21)=isign(kfpr(isub,1),kcs)
1389 ELSEIF(isub.EQ.214)
THEN
1391 mint(21)=isign(ksusy1+16,kcs)
1395 ELSEIF(isub.LE.225)
THEN
1396 IF(isub.EQ.216)
THEN
1401 ELSEIF(isub.EQ.217)
THEN
1406 ELSEIF(isub.EQ.218 )
THEN
1411 ELSEIF(isub.EQ.219 )
THEN
1416 ELSEIF(isub.EQ.220 )
THEN
1418 IF(
mint(15).LT.0) js=2
1420 mint(20+js)=ksusy1+22
1421 mint(23-js)=ksusy1+23
1423 ELSEIF(isub.EQ.221 )
THEN
1425 IF(
mint(15).LT.0) js=2
1427 mint(20+js)=ksusy1+22
1428 mint(23-js)=ksusy1+25
1430 ELSEIF(isub.EQ.222)
THEN
1432 IF(
mint(15).LT.0) js=2
1434 mint(20+js)=ksusy1+22
1435 mint(23-js)=ksusy1+35
1437 ELSEIF(isub.EQ.223)
THEN
1439 IF(
mint(15).LT.0) js=2
1441 mint(20+js)=ksusy1+23
1442 mint(23-js)=ksusy1+25
1444 ELSEIF(isub.EQ.224)
THEN
1446 IF(
mint(15).LT.0) js=2
1448 mint(20+js)=ksusy1+23
1449 mint(23-js)=ksusy1+35
1451 ELSEIF(isub.EQ.225)
THEN
1453 IF(
mint(15).LT.0) js=2
1455 mint(20+js)=ksusy1+25
1456 mint(23-js)=ksusy1+35
1459 ELSEIF(isub.LE.236)
THEN
1460 IF(isub.EQ.226)
THEN
1463 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1464 mint(21)=isign(ksusy1+24,kch1)
1467 ELSEIF(isub.EQ.227)
THEN
1469 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1470 mint(21)=isign(ksusy1+37,kch1)
1473 ELSEIF(isub.EQ.228)
THEN
1481 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1483 IF(
mint(2).EQ.1)
THEN
1484 mint(21)= isign(ksusy1+24,kch1)
1485 mint(22)= -isign(ksusy1+37,kch1)
1488 mint(21)= isign(ksusy1+37,kch1)
1489 mint(22)= -isign(ksusy1+24,kch1)
1494 ELSEIF(isub.EQ.229)
THEN
1497 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1498 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1500 IF(mod(
mint(15),2).EQ.0) js=2
1501 mint(20+js)=ksusy1+22
1502 mint(23-js)=isign(ksusy1+24,kch1+kch2)
1504 ELSEIF(isub.EQ.230)
THEN
1506 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1507 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1508 IF(mod(
mint(15),2).EQ.0) js=2
1509 mint(20+js)=ksusy1+23
1510 mint(23-js)=isign(ksusy1+24,kch1+kch2)
1512 ELSEIF(isub.EQ.231)
THEN
1514 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1515 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1516 IF(mod(
mint(15),2).EQ.0) js=2
1517 mint(20+js)=ksusy1+25
1518 mint(23-js)=isign(ksusy1+24,kch1+kch2)
1520 ELSEIF(isub.EQ.232)
THEN
1522 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1523 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1524 IF(mod(
mint(15),2).EQ.0) js=2
1525 mint(20+js)=ksusy1+35
1526 mint(23-js)=isign(ksusy1+24,kch1+kch2)
1528 ELSEIF(isub.EQ.233)
THEN
1530 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1531 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1532 IF(mod(
mint(15),2).EQ.0) js=2
1533 mint(20+js)=ksusy1+22
1534 mint(23-js)=isign(ksusy1+37,kch1+kch2)
1536 ELSEIF(isub.EQ.234)
THEN
1538 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1539 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1540 IF(mod(
mint(15),2).EQ.0) js=2
1541 mint(20+js)=ksusy1+23
1542 mint(23-js)=isign(ksusy1+37,kch1+kch2)
1544 ELSEIF(isub.EQ.235)
THEN
1546 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1547 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1548 IF(mod(
mint(15),2).EQ.0) js=2
1549 mint(20+js)=ksusy1+25
1550 mint(23-js)=isign(ksusy1+37,kch1+kch2)
1552 ELSEIF(isub.EQ.236)
THEN
1554 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1555 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1556 IF(mod(
mint(15),2).EQ.0) js=2
1557 mint(20+js)=ksusy1+35
1558 mint(23-js)=isign(ksusy1+37,kch1+kch2)
1561 ELSEIF(isub.LE.245)
THEN
1562 IF(isub.EQ.237)
THEN
1565 IF(
pyr(0).GT.0.5d0) js=2
1566 mint(20+js)=ksusy1+21
1567 mint(23-js)=ksusy1+22
1570 ELSEIF(isub.EQ.238)
THEN
1573 IF(
pyr(0).GT.0.5d0) js=2
1574 mint(20+js)=ksusy1+21
1575 mint(23-js)=ksusy1+23
1578 ELSEIF(isub.EQ.239)
THEN
1581 IF(
pyr(0).GT.0.5d0) js=2
1582 mint(20+js)=ksusy1+21
1583 mint(23-js)=ksusy1+25
1586 ELSEIF(isub.EQ.240)
THEN
1589 IF(
pyr(0).GT.0.5d0) js=2
1590 mint(20+js)=ksusy1+21
1591 mint(23-js)=ksusy1+35
1594 ELSEIF(isub.EQ.241)
THEN
1601 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1602 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1604 IF(
mint(15)*(kch1+kch2).GT.0) js=2
1605 mint(20+js)=ksusy1+21
1606 mint(23-js)=isign(ksusy1+24,kch1+kch2)
1609 ELSEIF(isub.EQ.242)
THEN
1616 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1617 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1619 IF(
mint(15)*(kch1+kch2).GT.0) js=2
1620 mint(20+js)=ksusy1+21
1621 mint(23-js)=isign(ksusy1+37,kch1+kch2)
1624 ELSEIF(isub.EQ.243)
THEN
1630 ELSEIF(isub.EQ.244)
THEN
1633 kcs=(-1)**int(1.5d0+
pyr(0))
1638 ELSEIF(isub.LE.260)
THEN
1639 IF(isub.EQ.246)
THEN
1641 IF(
mint(15).EQ.21) js=2
1644 mint(20+js)=isign(ksusy1+ia,
i)
1645 mint(23-js)=ksusy1+22
1647 kcs=isign(1,
mint(14+js))
1649 ELSEIF(isub.EQ.247)
THEN
1651 IF(
mint(15).EQ.21) js=2
1654 mint(20+js)=isign(ksusy2+ia,
i)
1655 mint(23-js)=ksusy1+22
1657 kcs=isign(1,
mint(14+js))
1659 ELSEIF(isub.EQ.248)
THEN
1661 IF(
mint(15).EQ.21) js=2
1664 mint(20+js)=isign(ksusy1+ia,
i)
1665 mint(23-js)=ksusy1+23
1667 kcs=isign(1,
mint(14+js))
1669 ELSEIF(isub.EQ.249)
THEN
1671 IF(
mint(15).EQ.21) js=2
1674 mint(20+js)=isign(ksusy2+ia,
i)
1675 mint(23-js)=ksusy1+23
1677 kcs=isign(1,
mint(14+js))
1679 ELSEIF(isub.EQ.250)
THEN
1681 IF(
mint(15).EQ.21) js=2
1684 mint(20+js)=isign(ksusy1+ia,
i)
1685 mint(23-js)=ksusy1+25
1687 kcs=isign(1,
mint(14+js))
1689 ELSEIF(isub.EQ.251)
THEN
1691 IF(
mint(15).EQ.21) js=2
1694 mint(20+js)=isign(ksusy2+ia,
i)
1695 mint(23-js)=ksusy1+25
1697 kcs=isign(1,
mint(14+js))
1699 ELSEIF(isub.EQ.252)
THEN
1701 IF(
mint(15).EQ.21) js=2
1704 mint(20+js)=isign(ksusy1+ia,
i)
1705 mint(23-js)=ksusy1+35
1707 kcs=isign(1,
mint(14+js))
1709 ELSEIF(isub.EQ.253)
THEN
1711 IF(
mint(15).EQ.21) js=2
1714 mint(20+js)=isign(ksusy2+ia,
i)
1715 mint(23-js)=ksusy1+35
1717 kcs=isign(1,
mint(14+js))
1719 ELSEIF(isub.EQ.254)
THEN
1721 IF(
mint(15).EQ.21) js=2
1724 mint(23-js)=isign(ksusy1+24,kchg(ia,1)*
i)
1725 ib=-ia+int((ia+1)/2)*4-1
1726 mint(20+js)=isign(ksusy1+ib,
i)
1728 kcs=isign(1,
mint(14+js))
1730 ELSEIF(isub.EQ.255)
THEN
1732 IF(
mint(15).EQ.21) js=2
1735 mint(23-js)=isign(ksusy1+24,kchg(ia,1)*
i)
1736 ib=-ia+int((ia+1)/2)*4-1
1737 mint(20+js)=isign(ksusy2+ib,
i)
1739 kcs=isign(1,
mint(14+js))
1741 ELSEIF(isub.EQ.256)
THEN
1743 IF(
mint(15).EQ.21) js=2
1746 ib=-ia+int((ia+1)/2)*4-1
1747 mint(20+js)=isign(ksusy1+ib,
i)
1748 mint(23-js)=isign(ksusy1+37,kchg(ia,1)*
i)
1750 kcs=isign(1,
mint(14+js))
1752 ELSEIF(isub.EQ.257)
THEN
1754 IF(
mint(15).EQ.21) js=2
1757 ib=-ia+int((ia+1)/2)*4-1
1758 mint(20+js)=isign(ksusy2+ib,
i)
1759 mint(23-js)=isign(ksusy1+37,kchg(ia,1)*
i)
1761 kcs=isign(1,
mint(14+js))
1763 ELSEIF(isub.EQ.258)
THEN
1765 IF(
mint(15).EQ.21) js=2
1768 mint(20+js)=isign(ksusy1+ia,
i)
1769 mint(23-js)=ksusy1+21
1771 IF(js.EQ.2) kcc=kcc+2
1774 ELSEIF(isub.EQ.259)
THEN
1776 IF(
mint(15).EQ.21) js=2
1779 mint(20+js)=isign(ksusy2+ia,
i)
1780 mint(23-js)=ksusy1+21
1782 IF(js.EQ.2) kcc=kcc+2
1786 ELSEIF(isub.LE.270)
THEN
1787 IF(isub.EQ.261)
THEN
1790 IF(
mint(43).EQ.1.AND.
pyr(0).GT.0.5d0) isgn=-1
1791 mint(21)=isgn*isign(kfpr(isub,1),kcs)
1794 IF(
mint(43).EQ.4) kcc=4
1796 ELSEIF(isub.EQ.262)
THEN
1799 IF(
mint(43).EQ.1.AND.
pyr(0).GT.0.5d0) isgn=-1
1800 mint(21)=isgn*isign(kfpr(isub,1),kcs)
1803 IF(
mint(43).EQ.4) kcc=4
1805 ELSEIF(isub.EQ.263)
THEN
1807 IF((kcs.GT.0.AND.
mint(2).EQ.1).OR.
1808 & (kcs.LT.0.AND.
mint(2).EQ.2))
THEN
1809 mint(21)=isign(kfpr(isub,1),kcs)
1810 mint(22)=-isign(kfpr(isub,2),kcs)
1813 mint(21)=isign(kfpr(isub,2),kcs)
1814 mint(22)=-isign(kfpr(isub,1),kcs)
1817 IF(
mint(43).EQ.4) kcc=4
1819 ELSEIF(isub.EQ.264)
THEN
1821 kcs=(-1)**int(1.5d0+
pyr(0))
1822 mint(21)=isign(kfpr(isub,1),kcs)
1826 ELSEIF(isub.EQ.265)
THEN
1828 kcs=(-1)**int(1.5d0+
pyr(0))
1829 mint(21)=isign(kfpr(isub,1),kcs)
1834 ELSEIF(isub.LE.296)
THEN
1835 IF(isub.EQ.271.OR.isub.EQ.281.OR.isub.EQ.291)
THEN
1838 IF(
mint(15)*
mint(16).LT.0) kcc=kcc+2
1842 ELSEIF(isub.EQ.272.OR.isub.EQ.282.OR.isub.EQ.292)
THEN
1845 IF(
mint(15)*
mint(16).LT.0) kcc=kcc+2
1849 ELSEIF(isub.EQ.273.OR.isub.EQ.283.OR.isub.EQ.293)
THEN
1851 mint(21)=isign(kfpr(isub,1),
mint(15))
1852 mint(22)=isign(kfpr(isub,2),
mint(16))
1854 IF(
mint(15)*
mint(16).LT.0) kcc=kcc+2
1856 ELSEIF(isub.EQ.274.OR.isub.EQ.284)
THEN
1861 IF(
mint(15)*
mint(16).LT.0) kcc=kcc+2
1863 ELSEIF(isub.EQ.275.OR.isub.EQ.285)
THEN
1868 IF(
mint(15)*
mint(16).LT.0) kcc=kcc+2
1870 ELSEIF(isub.EQ.276.OR.isub.EQ.286.OR.isub.EQ.296)
THEN
1872 mint(21)=isign(kfpr(isub,1),
mint(15))
1873 mint(22)=isign(kfpr(isub,2),
mint(16))
1875 IF(
mint(15)*
mint(16).LT.0) kcc=kcc+2
1877 ELSEIF(isub.EQ.277.OR.isub.EQ.287)
THEN
1880 IF(
mint(43).EQ.1.AND.
pyr(0).GT.0.5d0) isgn=-1
1881 mint(21)=isgn*isign(kfpr(isub,1),kcs)
1883 IF(
mint(43).EQ.4) kcc=4
1885 ELSEIF(isub.EQ.278.OR.isub.EQ.288)
THEN
1888 IF(
mint(43).EQ.1.AND.
pyr(0).GT.0.5d0) isgn=-1
1889 mint(21)=isgn*isign(kfpr(isub,1),kcs)
1891 IF(
mint(43).EQ.4) kcc=4
1893 ELSEIF(isub.EQ.279.OR.isub.EQ.289)
THEN
1896 kcs=(-1)**int(1.5d0+
pyr(0))
1897 mint(21)=isign(kfpr(isub,1),kcs)
1901 ELSEIF(isub.EQ.280.OR.isub.EQ.290)
THEN
1903 kcs=(-1)**int(1.5d0+
pyr(0))
1904 mint(21)=isign(kfpr(isub,1),kcs)
1908 ELSEIF(isub.EQ.294)
THEN
1910 IF(
mint(15).EQ.21) js=2
1913 mint(20+js)=isign(ksusy1+ia,
i)
1914 mint(23-js)=ksusy1+21
1916 IF(js.EQ.2) kcc=kcc+2
1919 ELSEIF(isub.EQ.295)
THEN
1921 IF(
mint(15).EQ.21) js=2
1924 mint(20+js)=isign(ksusy2+ia,
i)
1925 mint(23-js)=ksusy1+21
1927 IF(js.EQ.2) kcc=kcc+2
1931 ELSEIF(isub.LE.340)
THEN
1933 IF(isub.EQ.297.OR.isub.EQ.298)
THEN
1935 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1936 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1937 IF(
mint(15)*(kch1+kch2).GT.0) js=2
1938 mint(20+js)=isign(37,kch1+kch2)
1939 mint(23-js)=kfpr(isub,2)
1940 ELSEIF(isub.EQ.299.OR.isub.EQ.300)
THEN
1942 IF(
pyr(0).GT.0.5d0) js=2
1943 mint(20+js)=kfpr(isub,1)
1944 mint(23-js)=kfpr(isub,2)
1945 ELSEIF(isub.EQ.301)
THEN
1947 mint(21)=isign(kfpr(isub,1),kcs)
1952 ELSEIF(isub.LE.360)
THEN
1954 IF(isub.EQ.341.OR.isub.EQ.342)
THEN
1956 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
1957 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
1958 kfres=isign(kfpr(isub,1),kch1+kch2)
1960 ELSEIF(isub.GE.343.AND.isub.LE.348)
THEN
1962 IF(
mint(15).EQ.22) js=2
1963 mint(20+js)=isign(kfpr(isub,1),-
mint(14+js))
1964 mint(23-js)=isign(kfpr(isub,2),-
mint(14+js))
1967 ELSEIF(isub.EQ.349.OR.isub.EQ.350)
THEN
1969 mint(21)=-isign(kfpr(isub,1),
mint(15))
1972 ELSEIF(isub.EQ.351.OR.isub.EQ.352)
THEN
1982 ipm=(5-isign(1,
i))/2
1984 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 440
1985 mint(20+jt)=isign(ib,
i)
1986 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
1987 IF(rvckm.LE.0d0) goto 450
1990 ib=2*((ia+1)/2)-1+mod(ia,2)
1991 mint(20+jt)=isign(ib,
i)
1995 kfres=isign(kfpr(isub,1),
mint(15))
1996 IF(mod(
mint(15),2).EQ.1) kfres=-kfres
1998 ELSEIF(isub.EQ.353)
THEN
2002 ELSEIF(isub.EQ.354)
THEN
2004 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
2005 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
2006 kfres=isign(kfpr(isub,1),kch1+kch2)
2010 ELSEIF(isub.LE.380)
THEN
2012 IF(isub.LE.363.OR.isub.EQ.368)
THEN
2014 ksw=(-1)**int(1.5d0+
pyr(0))
2015 mint(21)=isign(kfpr(isub,1),ksw)
2016 mint(22)=-isign(kfpr(isub,2),ksw)
2018 ELSEIF(isub.LE.367)
THEN
2020 mint(21)=kfpr(isub,1)
2021 mint(22)=kfpr(isub,2)
2023 ELSEIF(isub.EQ.374.OR.isub.EQ.375)
THEN
2027 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
2028 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
2029 IF(
mint(15)*(kch1+kch2).LT.0) js=2
2030 mint(23-js)=isign(kfpr(isub,ic),kch1+kch2)
2031 mint(20+js)=kfpr(isub,
in)
2033 ELSEIF(isub.GE.370.AND.isub.LE.377)
THEN
2037 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
2038 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
2039 IF(
mint(15)*(kch1+kch2).GT.0) js=2
2040 mint(20+js)=isign(kfpr(isub,ic),kch1+kch2)
2041 mint(23-js)=kfpr(isub,
in)
2044 ELSEIF(isub.LE.400)
THEN
2045 IF(isub.EQ.381)
THEN
2048 IF(
mint(15)*
mint(16).LT.0) kcc=kcc+2
2050 ELSEIF(isub.EQ.382)
THEN
2056 ELSEIF(isub.EQ.383)
THEN
2062 ELSEIF(isub.EQ.384)
THEN
2064 IF(
mint(15).EQ.21) js=2
2066 IF(
mint(15).EQ.21) kcc=kcc+2
2067 IF(
mint(15).NE.21) kcs=isign(1,
mint(15))
2068 IF(
mint(16).NE.21) kcs=isign(1,
mint(16))
2070 ELSEIF(isub.EQ.385)
THEN
2072 kcs=(-1)**int(1.5d0+
pyr(0))
2073 mint(21)=isign(kflf,kcs)
2077 ELSEIF(isub.EQ.386)
THEN
2080 kcs=(-1)**int(1.5d0+
pyr(0))
2082 ELSEIF(isub.EQ.387)
THEN
2088 ELSEIF(isub.EQ.388)
THEN
2090 kcs=(-1)**int(1.5d0+
pyr(0))
2095 ELSEIF(isub.EQ.391)
THEN
2099 ELSEIF(isub.EQ.392)
THEN
2104 ELSEIF(isub.EQ.393)
THEN
2106 IF(
pyr(0).GT.0.5d0) js=2
2107 mint(20+js)=kfpr(isub,1)
2108 mint(23-js)=kfpr(isub,2)
2111 ELSEIF(isub.EQ.394)
THEN
2113 IF(
mint(15).EQ.21) js=2
2114 mint(23-js)=kfpr(isub,2)
2116 kcs=isign(1,
mint(14+js))
2118 ELSEIF(isub.EQ.395)
THEN
2120 IF(
pyr(0).GT.0.5d0) js=2
2121 mint(23-js)=kfpr(isub,2)
2125 ELSEIF(isub.LE.420)
THEN
2126 IF(isub.EQ.401)
THEN
2128 kcs=(-1)**int(1.5d0+
pyr(0))
2129 mint(21)=isign(kfpr(isubsv,2),kcs)
2130 mint(22)=isign(5,-kcs)
2131 kcc=11+int(0.5d0+
pyr(0))
2132 kfres=isign(kfhigg,-kcs)
2134 ELSEIF(isub.EQ.402)
THEN
2136 kfl=(-1)**int(1.5d0+
pyr(0))
2137 mint(21)=isign(int(6.+.5*kfl),kcs)
2138 mint(22)=isign(int(6.-.5*kfl),-kcs)
2140 kfres=isign(kfhigg,-kfl*kcs)
2145 ELSEIF(isub.LE.430)
THEN
2146 IF(isub.GE.421.AND.isub.LE.424)
THEN
2154 mint(21)=kfpr(isubsv,1)
2155 mint(22)=kfpr(isubsv,2)
2156 IF(isub.EQ.421)
THEN
2158 kcs=(-1)**int(1.5d0+
pyr(0))
2161 kcs=(-1)**int(1.5d0+
pyr(0))
2164 ELSEIF(isub.GE.425.AND.isub.LE.427)
THEN
2170 IF(
mint(15).EQ.21) js=2
2171 mint(23-js)=kfpr(isubsv,2)
2173 IF(
mint(15).EQ.21) kcc=kcc+2
2174 IF(
mint(15).NE.21) kcs=isign(1,
mint(15))
2175 IF(
mint(16).NE.21) kcs=isign(1,
mint(16))
2177 ELSEIF(isub.GE.428.AND.isub.LE.430)
THEN
2183 IF(
pyr(0).GT.0.5) js=2
2185 mint(23-js)=kfpr(isubsv,2)
2189 ELSEIF(isub.LE.440)
THEN
2190 IF(isub.GE.431.AND.isub.LE.433)
THEN
2196 mint(21)=kfpr(isubsv,1)
2197 mint(22)=kfpr(isubsv,2)
2199 kcs=(-1)**int(1.5d0+
pyr(0))
2201 ELSEIF(isub.GE.434.AND.isub.LE.436)
THEN
2207 IF(
mint(15).EQ.21) js=2
2208 mint(23-js)=kfpr(isubsv,2)
2210 kcs=isign(1,
mint(14+js))
2212 ELSEIF(isub.GE.437.AND.isub.LE.439)
THEN
2218 IF(
pyr(0).GT.0.5) js=2
2220 mint(23-js)=kfpr(isubsv,2)
2227 IF(iset(isub).EQ.11)
THEN
2229 bezup=(pup(3,1)+pup(3,2))/(pup(4,1)+pup(4,2))
2235 IF(
mstp(128).GE.2.AND.mothup(1,iup).GE.3)
THEN
2244 IF(idup(iup).EQ.0)
k(
i,2)=90
2246 IF(mothup(1,iup).GE.3)
k(
i,3)=kuppo(mothup(1,iup))
2262 IF(istup(iup).EQ.2.OR.istup(iup).EQ.3)
k(
n,1)=11
2264 IF(idup(iup).EQ.0)
k(
n,2)=90
2265 IF(
mstp(128).LE.0.OR.mothup(1,iup).EQ.0)
THEN
2268 k(
n,3)=
mint(84)+mothup(1,iup)
2273 IF(
k(
n,1).EQ.11.AND.kchg(
pycomp(
k(
n,2)),2).EQ.0)
THEN
2274 DO 475 iupdau=iup+1,nup
2275 IF(mothup(1,iupdau).EQ.iup.AND.
k(
n,4).EQ.0)
k(
n,4)=
2277 IF(mothup(1,iupdau).EQ.iup)
k(
n,5)=
n+iupdau-iup
2291 IF(kchg(
pycomp(
k(
i1,2)),2).EQ.0) goto 540
2292 IF(
k(
i1,1).EQ.1)
k(
i1,1)=3
2293 IF(
k(
i1,1).EQ.11)
k(
i1,1)=14
2296 IF(icolup(isde1,iup1).EQ.0) goto 530
2299 IF(icolup(isde1,iup1).EQ.ilab(ilbl)) nmat=1
2303 ilab(nlbl)=icolup(isde1,iup1)
2307 DO 520 iup2=iup1+1,nup
2310 IF(icolup(isde2,iup2).EQ.icolup(isde1,iup1))
THEN
2311 IF(isde2.EQ.isde1)
THEN
2313 k(
i2,3+isde2)=
k(
i2,3+isde2)+mstu(5)*
i3
2315 ELSEIF(
i4.NE.0)
THEN
2317 k(
i2,3+isde2)=
k(
i2,3+isde2)+mstu(5)*
i4
2319 ELSEIF(iup2.LE.2)
THEN
2324 k(
i1,3+isde1)=
k(
i1,3+isde1)+mstu(5)*
i2
2325 k(
i2,3+isde2)=
k(
i2,3+isde2)+mstu(5)*
i1
2335 ELSEIF(idoc.EQ.7)
THEN
2353 IF(kchg(kcres,2).NE.0)
THEN
2357 IF(kcs.EQ.-1) jc=3-
j
2358 IF(icol(kcc,1,jc).NE.0.AND.
k(ipu1,1).EQ.14)
k(ipu1,
j+3)=
2359 &
mint(84)+icol(kcc,1,jc)
2360 IF(icol(kcc,2,jc).NE.0.AND.
k(ipu2,1).EQ.14)
k(ipu2,
j+3)=
2361 &
mint(84)+icol(kcc,2,jc)
2362 IF(icol(kcc,3,jc).NE.0.AND.
k(ipu3,1).EQ.3)
k(ipu3,
j+3)=
2363 & mstu(5)*(
mint(84)+icol(kcc,3,jc))
2372 ELSEIF(idoc.EQ.8)
THEN
2378 IF(kchg(kca,2).NE.0)
k(
i,1)=3
2380 k(
i,3)=
mint(83)+idoc+jt-2
2382 IF(kfpr(isubsv,1+mod(js+jt,2)).NE.0)
THEN
2383 p(
i,5)=sqrt(
vint(63+mod(js+jt,2)))
2387 IF((kfaa.EQ.6.OR.kfaa.EQ.7.OR.kfaa.EQ.8).AND.
2390 IF(
p(ipu3,5)+
p(ipu4,5).GE.shr)
THEN
2393 IF((kfa1.GT.3.AND.kfa1.NE.21).OR.(kfa2.GT.3.AND.kfa2.NE.21))
2401 p(ipu3,4)=0.5d0*(shr+(
p(ipu3,5)**2-
p(ipu4,5)**2)/shr)
2402 p(ipu3,3)=sqrt(
max(0d0,
p(ipu3,4)**2-
p(ipu3,5)**2))
2403 p(ipu4,4)=shr-
p(ipu3,4)
2404 p(ipu4,3)=-
p(ipu3,3)
2412 ELSEIF(idoc.EQ.9)
THEN
2418 IF(kchg(kca,2).NE.0)
k(
i,1)=3
2420 k(
i,3)=
mint(83)+idoc+jt-3
2424 IF(isub.EQ.402.AND.iabs(
mint(21)).EQ.5) jta=3-jt
2425 IF(iabs(
k(
i,2)).LE.22)
THEN
2428 p(
i,5)=sqrt(
vint(63+mod(js+jta,2)))
2436 k(ipu5,3)=
mint(83)+idoc
2438 p(ipu5,1)=-
p(ipu3,1)-
p(ipu4,1)
2439 p(ipu5,2)=-
p(ipu3,2)-
p(ipu4,2)
2440 pms1=
p(ipu3,5)**2+
p(ipu3,1)**2+
p(ipu3,2)**2
2441 pms2=
p(ipu4,5)**2+
p(ipu4,1)**2+
p(ipu4,2)**2
2442 pms3=
p(ipu5,5)**2+
p(ipu5,1)**2+
p(ipu5,2)**2
2444 p(ipu5,3)=pmt3*sinh(
vint(211))
2445 p(ipu5,4)=pmt3*cosh(
vint(211))
2446 pms12=(shpr-
p(ipu5,4))**2-
p(ipu5,3)**2
2447 sql12=(pms12-pms1-pms2)**2-4d0*pms1*pms2
2448 IF(sql12.LE.0d0)
THEN
2452 p(ipu3,3)=(-
p(ipu5,3)*(pms12+pms1-pms2)+
2453 &
vint(213)*(shpr-
p(ipu5,4))*sqrt(sql12))/(2d0*pms12)
2454 p(ipu4,3)=-
p(ipu3,3)-
p(ipu5,3)
2455 IF(isub.EQ.402.AND.iabs(
mint(21)).EQ.5)
THEN
2458 p(ipu4,3)=(-
p(ipu5,3)*(pms12+pms2-pms1)+
2459 &
vint(213)*(shpr-
p(ipu5,4))*sqrt(sql12))/(2d0*pms12)
2460 p(ipu3,3)=-
p(ipu4,3)-
p(ipu5,3)
2462 p(ipu3,4)=sqrt(pms1+
p(ipu3,3)**2)
2463 p(ipu4,4)=sqrt(pms2+
p(ipu4,3)**2)
2469 ELSEIF(idoc.EQ.11)
THEN
2478 k(
i,3)=
mint(83)+idoc+jt-2
2480 IF(0.5d0*shpr*
z(jt).LE.
p(
i,5))
THEN
2484 pabs=sqrt(
max(0d0,(0.5d0*shpr*
z(jt))**2-
p(
i,5)**2))
2485 ptabs=pabs*sqrt(
max(0d0,1d0-cthe(jt)**2))
2486 p(
i,1)=ptabs*cos(
phi(jt))
2487 p(
i,2)=ptabs*sin(
phi(jt))
2488 p(
i,3)=pabs*cthe(jt)*(-1)**(jt+1)
2489 p(
i,4)=0.5d0*shpr*
z(jt)
2493 IF(isub.EQ.8)
k(izw,2)=isign(24,
pychge(
mint(14+jt)))
2497 p(izw,3)=(0.5d0*shpr-pabs*cthe(jt))*(-1)**(jt+1)
2498 p(izw,4)=0.5d0*shpr*(1d0-
z(jt))
2499 p(izw,5)=-sqrt(
max(0d0,
p(izw,3)**2+ptabs**2-
p(izw,4)**2))
2506 p(ipu5,1)=-
p(ipu3,1)-
p(ipu4,1)
2507 p(ipu5,2)=-
p(ipu3,2)-
p(ipu4,2)
2508 p(ipu5,3)=-
p(ipu3,3)-
p(ipu4,3)
2509 p(ipu5,4)=shpr-
p(ipu3,4)-
p(ipu4,4)
2518 ELSEIF(idoc.EQ.12)
THEN
2522 jtran=int(1.5d0+
pyr(0))
2528 k(
i,3)=
mint(83)+idoc+jt-2
2530 IF(0.5d0*shpr*
z(jt).LE.
p(
i,5))
p(
i,5)=0d0
2531 pabs=sqrt(
max(0d0,(0.5d0*shpr*
z(jt))**2-
p(
i,5)**2))
2532 ptabs=pabs*sqrt(
max(0d0,1d0-cthe(jt)**2))
2533 p(
i,1)=ptabs*cos(
phi(jt))
2534 p(
i,2)=ptabs*sin(
phi(jt))
2535 p(
i,3)=pabs*cthe(jt)*(-1)**(jt+1)
2536 p(
i,4)=0.5d0*shpr*
z(jt)
2539 IF(
mint(14+jt).EQ.
mint(20+jt))
THEN
2547 p(izw,3)=(0.5d0*shpr-pabs*cthe(jt))*(-1)**(jt+1)
2548 p(izw,4)=0.5d0*shpr*(1d0-
z(jt))
2549 p(izw,5)=-sqrt(
max(0d0,
p(izw,3)**2+ptabs**2-
p(izw,4)**2))
2552 k(ipu,2)=kfpr(isub,jt)
2553 IF(isub.EQ.72.AND.jt.EQ.jtran)
k(ipu,2)=-
k(ipu,2)
2554 IF(isub.EQ.73.OR.isub.EQ.77)
k(ipu,2)=
k(izw,2)
2555 k(ipu,3)=
mint(83)+8+jt
2556 IF(iabs(
k(ipu,2)).LE.10.OR.
k(ipu,2).EQ.21)
THEN
2559 p(ipu,5)=sqrt(
vint(63+mod(js+jt,2)))
2561 mint(22+jt)=
k(ipu,2)
2569 gamcm=(
p(
i1,4)+
p(
i2,4))/shr
2570 bepcm=bexcm*
p(
i1,1)+beycm*
p(
i1,2)+bezcm*
p(
i1,3)
2571 px=
p(
i1,1)+gamcm*(gamcm/(1d0+gamcm)*bepcm-
p(
i1,4))*bexcm
2572 py=
p(
i1,2)+gamcm*(gamcm/(1d0+gamcm)*bepcm-
p(
i1,4))*beycm
2573 pz=
p(
i1,3)+gamcm*(gamcm/(1d0+gamcm)*bepcm-
p(
i1,4))*bezcm
2577 sqlam=(sh-
p(ipu5,5)**2-
p(ipu6,5)**2)**2-4d0*
p(ipu5,5)**2*
2579 pabs=sqrt(
max(0d0,sqlam/(4d0*sh)))
2581 sthwz=sqrt(
max(0d0,1d0-cthwz**2))
2582 phiwz=
vint(24)-phicm
2583 p(ipu5,1)=pabs*sthwz*cos(phiwz)
2584 p(ipu5,2)=pabs*sthwz*sin(phiwz)
2585 p(ipu5,3)=pabs*cthwz
2586 p(ipu5,4)=sqrt(pabs**2+
p(ipu5,5)**2)
2587 p(ipu6,1)=-
p(ipu5,1)
2588 p(ipu6,2)=-
p(ipu5,2)
2589 p(ipu6,3)=-
p(ipu5,3)
2590 p(ipu6,4)=sqrt(pabs**2+
p(ipu6,5)**2)
2591 CALL
pyrobo(ipu5,ipu6,thecm,phicm,bexcm,beycm,bezcm)
2606 IF(iset(isub).EQ.11)
THEN
2607 ELSEIF(idoc.GE.8)
THEN
2611 IF(kcs.EQ.-1) jc=3-
j
2612 IF(icol(kcc,1,jc).NE.0.AND.
k(ipu1,1).EQ.14)
k(ipu1,
j+3)=
2613 &
k(ipu1,
j+3)+
mint(84)+icol(kcc,1,jc)
2614 IF(icol(kcc,2,jc).NE.0.AND.
k(ipu2,1).EQ.14)
k(ipu2,
j+3)=
2615 &
k(ipu2,
j+3)+
mint(84)+icol(kcc,2,jc)
2616 IF(icol(kcc,3,jc).NE.0.AND.
k(ipu3,1).EQ.3)
k(ipu3,
j+3)=
2617 & mstu(5)*(
mint(84)+icol(kcc,3,jc))
2618 IF(icol(kcc,4,jc).NE.0.AND.
k(ipu4,1).EQ.3)
k(ipu4,
j+3)=
2619 & mstu(5)*(
mint(84)+icol(kcc,4,jc))
2624 IF(idoc.EQ.9) imax=3
2630 IF(idoc.LE.9)
k(
i1,3)=0
2631 IF(idoc.GE.11)
k(
i1,3)=
mint(83)+2+
i
2637 ELSEIF(idoc.EQ.9)
THEN
2641 IF(kcs.EQ.-1) jc=3-
j
2642 IF(icol(kcc,1,jc).NE.0.AND.
k(ipu1,1).EQ.14)
k(ipu1,
j+3)=
2643 &
k(ipu1,
j+3)+
mint(84)+icol(kcc,1,jc)+
2644 &
max(0,min(1,icol(kcc,1,jc)-2))
2645 IF(icol(kcc,2,jc).NE.0.AND.
k(ipu2,1).EQ.14)
k(ipu2,
j+3)=
2646 &
k(ipu2,
j+3)+
mint(84)+icol(kcc,2,jc)+
2647 &
max(0,min(1,icol(kcc,2,jc)-2))
2648 IF(icol(kcc,3,jc).NE.0.AND.
k(ipu4,1).EQ.3)
k(ipu4,
j+3)=
2649 & mstu(5)*(
mint(84)+icol(kcc,3,jc))
2650 IF(icol(kcc,4,jc).NE.0.AND.
k(ipu5,1).EQ.3)
k(ipu5,
j+3)=
2651 & mstu(5)*(
mint(84)+icol(kcc,4,jc))
2669 IF(
mint(35).GE.2.AND.iset(isub).NE.0)
THEN
2679 IF(
mint(35).LE.1)
THEN
2680 k(ipu3,1)=
k(ipu3,1)+10
2681 k(ipu4,1)=
k(ipu4,1)+10