8 common/lujets/
n,
k(9000,5),
p(9000,5),
v(9000,5)
10 common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
12 common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
14 common/ludat3/mdcy(500,3),mdme(2000,2),brat(2000),kfdp(2000,5)
16 common/pyhisubs/msel,msub(200),kfin(2,-40:40),ckin(200)
22 common/pyhiint2/iset(200),kfpr(200,2),coef(200,20),icol(40,4,2)
24 common/pyhiint3/xsfx(2,-40:40),isig(1000,3),sigh(1000)
26 common/pyhiint4/widp(21:40,0:40),wide(21:40,0:40),wids(21:40,3)
28 common/pyhiint5/
ngen(0:200,3),
xsec(0:200,3)
30 dimension wdtp(0:40),wdte(0:40,0:5),pmq(2),
z(2),cthe(2),
phi(2)
37 IF(idoc.GE.9) idoc=idoc+2
47 DO 100 jt=1,
mstp(126)+10
60 p(
i,3)=
vint(5)*(-1)**(jt+1)
61 110
p(
i,4)=sqrt(
p(
i,3)**2+
p(
i,5)**2)
71 IF(iset(isub).GE.3) shuser=shpr
78 IF(
p(ipu1,5)+
p(ipu2,5).GE.shuser)
THEN
82 p(ipu1,4)=0.5*(shuser+(
p(ipu1,5)**2-
p(ipu2,5)**2)/shuser)
83 p(ipu1,3)=sqrt(
max(0.,
p(ipu1,4)**2-
p(ipu1,5)**2))
84 p(ipu2,4)=shuser-
p(ipu1,4)
98 IF(isub.EQ.12.OR.isub.EQ.53)
THEN
100 rkfl=(wdte(0,1)+wdte(0,2)+wdte(0,4))*
rlu(0)
103 rkfl=rkfl-(wdte(
i,1)+wdte(
i,2)+wdte(
i,4))
104 IF(rkfl.LE.0.) goto 150
116 kcs=isign(1,
mint(15))
123 ELSEIF(isub.EQ.2)
THEN
125 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
126 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
127 kfres=isign(24,kch1+kch2)
129 ELSEIF(isub.EQ.3)
THEN
133 ELSEIF(isub.EQ.4)
THEN
136 ELSEIF(isub.EQ.5)
THEN
143 240 jt=int(1.5+
rlu(0))
145 zmax=1.-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/(shpr*(shpr-pmq(3-jt)))
147 z(jt)=zmin+(zmax-zmin)*
rlu(0)
148 IF(-1.+(1.+xh)/(1.-
z(jt))-xh/(1.-
z(jt))**2.LT.
149 & (1.-xh)**2/(4.*xh)*
rlu(0)) goto 240
150 sqc1=1.-4.*pmq(jt)**2/(
z(jt)**2*shp)
151 IF(sqc1.LT.1.
e-8) goto 240
153 c2=1.+2.*(pmas(23,1)**2-pmq(jt)**2)/(
z(jt)*shp)
154 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
155 cthe(jt)=min(1.,
max(-1.,cthe(jt)))
156 z(3-jt)=1.-xh/(1.-
z(jt))
157 sqc1=1.-4.*pmq(3-jt)**2/(
z(3-jt)**2*shp)
158 IF(sqc1.LT.1.
e-8) goto 240
160 c2=1.+2.*(pmas(23,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
161 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
162 cthe(3-jt)=min(1.,
max(-1.,cthe(3-jt)))
165 ang=cthe(1)*cthe(2)-sqrt(1.-cthe(1)**2)*sqrt(1.-cthe(2)**2)*cphi
167 z2=ang*sqrt(
z(jt)**2-4.*pmq(jt)**2/shp)
168 z3=1.-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
169 z(3-jt)=2./(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
171 zmin=2.*pmq(3-jt)/shpr
172 zmax=1.-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
174 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 240
178 ELSEIF(isub.EQ.6)
THEN
181 ELSEIF(isub.EQ.7)
THEN
184 ELSEIF(isub.EQ.8)
THEN
196 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 270
197 mint(20+jt)=isign(ib,
i)
198 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
199 IF(rvckm.LE.0.) goto 280
202 ib=2*((ia+1)/2)-1+mod(ia,2)
203 mint(20+jt)=isign(ib,
i)
208 zmax=1.-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/(shpr*(shpr-pmq(3-jt)))
210 z(jt)=zmin+(zmax-zmin)*
rlu(0)
211 IF(-1.+(1.+xh)/(1.-
z(jt))-xh/(1.-
z(jt))**2.LT.
212 & (1.-xh)**2/(4.*xh)*
rlu(0)) goto 250
213 sqc1=1.-4.*pmq(jt)**2/(
z(jt)**2*shp)
214 IF(sqc1.LT.1.
e-8) goto 250
216 c2=1.+2.*(pmas(24,1)**2-pmq(jt)**2)/(
z(jt)*shp)
217 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
218 cthe(jt)=min(1.,
max(-1.,cthe(jt)))
219 z(3-jt)=1.-xh/(1.-
z(jt))
220 sqc1=1.-4.*pmq(3-jt)**2/(
z(3-jt)**2*shp)
221 IF(sqc1.LT.1.
e-8) goto 250
223 c2=1.+2.*(pmas(24,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
224 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
225 cthe(3-jt)=min(1.,
max(-1.,cthe(3-jt)))
228 ang=cthe(1)*cthe(2)-sqrt(1.-cthe(1)**2)*sqrt(1.-cthe(2)**2)*cphi
230 z2=ang*sqrt(
z(jt)**2-4.*pmq(jt)**2/shp)
231 z3=1.-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
232 z(3-jt)=2./(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
234 zmin=2.*pmq(3-jt)/shpr
235 zmax=1.-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
237 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 250
242 ELSEIF(isub.LE.20)
THEN
246 IF(
mint(15)*
mint(16).LT.0) kcc=kcc+2
248 ELSEIF(isub.EQ.12)
THEN
254 ELSEIF(isub.EQ.13)
THEN
260 ELSEIF(isub.EQ.14)
THEN
262 IF(
rlu(0).GT.0.5) js=2
267 ELSEIF(isub.EQ.15)
THEN
269 IF(
rlu(0).GT.0.5) js=2
274 ELSEIF(isub.EQ.16)
THEN
276 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
277 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
278 IF(
mint(15)*(kch1+kch2).LT.0) js=2
280 mint(23-js)=isign(24,kch1+kch2)
283 ELSEIF(isub.EQ.17)
THEN
285 IF(
rlu(0).GT.0.5) js=2
290 ELSEIF(isub.EQ.18)
THEN
295 ELSEIF(isub.EQ.19)
THEN
297 IF(
rlu(0).GT.0.5) js=2
301 ELSEIF(isub.EQ.20)
THEN
303 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
304 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
305 IF(
mint(15)*(kch1+kch2).LT.0) js=2
307 mint(23-js)=isign(24,kch1+kch2)
310 ELSEIF(isub.LE.30)
THEN
313 IF(
rlu(0).GT.0.5) js=2
317 ELSEIF(isub.EQ.22)
THEN
322 ELSEIF(isub.EQ.23)
THEN
324 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
325 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
326 IF(
mint(15)*(kch1+kch2).LT.0) js=2
328 mint(23-js)=isign(24,kch1+kch2)
330 ELSEIF(isub.EQ.24)
THEN
332 IF(
rlu(0).GT.0.5) js=2
336 ELSEIF(isub.EQ.25)
THEN
341 ELSEIF(isub.EQ.26)
THEN
343 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
344 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
345 IF(
mint(15)*(kch1+kch2).GT.0) js=2
346 mint(20+js)=isign(24,kch1+kch2)
349 ELSEIF(isub.EQ.27)
THEN
352 ELSEIF(isub.EQ.28)
THEN
355 IF(
mint(15).EQ.21) kcc=kcc+2
356 IF(
mint(15).NE.21) kcs=isign(1,
mint(15))
357 IF(
mint(16).NE.21) kcs=isign(1,
mint(16))
359 ELSEIF(isub.EQ.29)
THEN
361 IF(
mint(15).EQ.21) js=2
364 kcs=isign(1,
mint(14+js))
366 ELSEIF(isub.EQ.30)
THEN
368 IF(
mint(15).EQ.21) js=2
371 kcs=isign(1,
mint(14+js))
374 ELSEIF(isub.LE.40)
THEN
377 IF(
mint(15).EQ.21) js=2
380 mint(23-js)=isign(24,kchg(ia,1)*
i)
386 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 220
387 mint(20+js)=isign(ib,
i)
388 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
389 IF(rvckm.LE.0.) goto 230
392 kcs=isign(1,
mint(14+js))
394 ELSEIF(isub.EQ.32)
THEN
396 IF(
mint(15).EQ.21) js=2
399 kcs=isign(1,
mint(14+js))
401 ELSEIF(isub.EQ.33)
THEN
404 ELSEIF(isub.EQ.34)
THEN
407 ELSEIF(isub.EQ.35)
THEN
410 ELSEIF(isub.EQ.36)
THEN
413 ELSEIF(isub.EQ.37)
THEN
416 ELSEIF(isub.EQ.38)
THEN
419 ELSEIF(isub.EQ.39)
THEN
422 ELSEIF(isub.EQ.40)
THEN
426 ELSEIF(isub.LE.50)
THEN
430 ELSEIF(isub.EQ.42)
THEN
433 ELSEIF(isub.EQ.43)
THEN
436 ELSEIF(isub.EQ.44)
THEN
439 ELSEIF(isub.EQ.45)
THEN
442 ELSEIF(isub.EQ.46)
THEN
445 ELSEIF(isub.EQ.47)
THEN
448 ELSEIF(isub.EQ.48)
THEN
451 ELSEIF(isub.EQ.49)
THEN
454 ELSEIF(isub.EQ.50)
THEN
458 ELSEIF(isub.LE.60)
THEN
462 ELSEIF(isub.EQ.52)
THEN
465 ELSEIF(isub.EQ.53)
THEN
467 kcs=(-1)**int(1.5+
rlu(0))
468 mint(21)=isign(kflq,kcs)
472 ELSEIF(isub.EQ.54)
THEN
475 ELSEIF(isub.EQ.55)
THEN
478 ELSEIF(isub.EQ.56)
THEN
481 ELSEIF(isub.EQ.57)
THEN
484 ELSEIF(isub.EQ.58)
THEN
487 ELSEIF(isub.EQ.59)
THEN
490 ELSEIF(isub.EQ.60)
THEN
494 ELSEIF(isub.LE.70)
THEN
498 ELSEIF(isub.EQ.62)
THEN
501 ELSEIF(isub.EQ.63)
THEN
504 ELSEIF(isub.EQ.64)
THEN
507 ELSEIF(isub.EQ.65)
THEN
510 ELSEIF(isub.EQ.66)
THEN
513 ELSEIF(isub.EQ.67)
THEN
516 ELSEIF(isub.EQ.68)
THEN
519 kcs=(-1)**int(1.5+
rlu(0))
521 ELSEIF(isub.EQ.69)
THEN
524 ELSEIF(isub.EQ.70)
THEN
528 ELSEIF(isub.LE.80)
THEN
529 IF(isub.EQ.71.OR.isub.EQ.72)
THEN
536 290 jt=int(1.5+
rlu(0))
538 zmax=1.-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/(shpr*(shpr-pmq(3-jt)))
540 z(jt)=zmin+(zmax-zmin)*
rlu(0)
541 IF(-1.+(1.+xh)/(1.-
z(jt))-xh/(1.-
z(jt))**2.LT.
542 & (1.-xh)**2/(4.*xh)*
rlu(0)) goto 290
543 sqc1=1.-4.*pmq(jt)**2/(
z(jt)**2*shp)
544 IF(sqc1.LT.1.
e-8) goto 290
546 c2=1.+2.*(pmas(23,1)**2-pmq(jt)**2)/(
z(jt)*shp)
547 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
548 cthe(jt)=min(1.,
max(-1.,cthe(jt)))
549 z(3-jt)=1.-xh/(1.-
z(jt))
550 sqc1=1.-4.*pmq(3-jt)**2/(
z(3-jt)**2*shp)
551 IF(sqc1.LT.1.
e-8) goto 290
553 c2=1.+2.*(pmas(23,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
554 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
555 cthe(3-jt)=min(1.,
max(-1.,cthe(3-jt)))
558 ang=cthe(1)*cthe(2)-sqrt(1.-cthe(1)**2)*sqrt(1.-cthe(2)**2)*cphi
560 z2=ang*sqrt(
z(jt)**2-4.*pmq(jt)**2/shp)
561 z3=1.-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
562 z(3-jt)=2./(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
564 zmin=2.*pmq(3-jt)/shpr
565 zmax=1.-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
567 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 290
570 ELSEIF(isub.EQ.73)
THEN
573 300 jt=int(1.5+
rlu(0))
582 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 320
583 mint(20+jt)=isign(ib,
i)
584 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
585 IF(rvckm.LE.0.) goto 330
588 ib=2*((ia+1)/2)-1+mod(ia,2)
589 mint(20+jt)=isign(ib,
i)
596 zmax=1.-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/(shpr*(shpr-pmq(3-jt)))
598 z(jt)=zmin+(zmax-zmin)*
rlu(0)
599 IF(-1.+(1.+xh)/(1.-
z(jt))-xh/(1.-
z(jt))**2.LT.
600 & (1.-xh)**2/(4.*xh)*
rlu(0)) goto 300
601 sqc1=1.-4.*pmq(jt)**2/(
z(jt)**2*shp)
602 IF(sqc1.LT.1.
e-8) goto 300
604 c2=1.+2.*(pmas(23,1)**2-pmq(jt)**2)/(
z(jt)*shp)
605 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
606 cthe(jt)=min(1.,
max(-1.,cthe(jt)))
607 z(3-jt)=1.-xh/(1.-
z(jt))
608 sqc1=1.-4.*pmq(3-jt)**2/(
z(3-jt)**2*shp)
609 IF(sqc1.LT.1.
e-8) goto 300
611 c2=1.+2.*(pmas(23,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
612 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
613 cthe(3-jt)=min(1.,
max(-1.,cthe(3-jt)))
616 ang=cthe(1)*cthe(2)-sqrt(1.-cthe(1)**2)*sqrt(1.-cthe(2)**2)*cphi
618 z2=ang*sqrt(
z(jt)**2-4.*pmq(jt)**2/shp)
619 z3=1.-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
620 z(3-jt)=2./(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
622 zmin=2.*pmq(3-jt)/shpr
623 zmax=1.-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
625 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 300
628 ELSEIF(isub.EQ.74)
THEN
631 ELSEIF(isub.EQ.75)
THEN
634 ELSEIF(isub.EQ.76.OR.isub.EQ.77)
THEN
646 IF(mdme(idc,1).NE.1.AND.mdme(idc,1).NE.ipm) goto 360
647 mint(20+jt)=isign(ib,
i)
648 rvckm=rvckm-vckm((ia+1)/2,(ib+1)/2)
649 IF(rvckm.LE.0.) goto 370
652 ib=2*((ia+1)/2)-1+mod(ia,2)
653 mint(20+jt)=isign(ib,
i)
658 zmax=1.-pmq(3-jt)/shpr-(sh-pmq(jt)**2)/(shpr*(shpr-pmq(3-jt)))
660 z(jt)=zmin+(zmax-zmin)*
rlu(0)
661 IF(-1.+(1.+xh)/(1.-
z(jt))-xh/(1.-
z(jt))**2.LT.
662 & (1.-xh)**2/(4.*xh)*
rlu(0)) goto 340
663 sqc1=1.-4.*pmq(jt)**2/(
z(jt)**2*shp)
664 IF(sqc1.LT.1.
e-8) goto 340
666 c2=1.+2.*(pmas(24,1)**2-pmq(jt)**2)/(
z(jt)*shp)
667 cthe(jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
668 cthe(jt)=min(1.,
max(-1.,cthe(jt)))
669 z(3-jt)=1.-xh/(1.-
z(jt))
670 sqc1=1.-4.*pmq(3-jt)**2/(
z(3-jt)**2*shp)
671 IF(sqc1.LT.1.
e-8) goto 340
673 c2=1.+2.*(pmas(24,1)**2-pmq(3-jt)**2)/(
z(3-jt)*shp)
674 cthe(3-jt)=(
c2-(
c2**2-c1**2)/(
c2+(2.*
rlu(0)-1.)*c1))/c1
675 cthe(3-jt)=min(1.,
max(-1.,cthe(3-jt)))
678 ang=cthe(1)*cthe(2)-sqrt(1.-cthe(1)**2)*sqrt(1.-cthe(2)**2)*cphi
680 z2=ang*sqrt(
z(jt)**2-4.*pmq(jt)**2/shp)
681 z3=1.-
z(jt)-xh+(pmq(1)**2+pmq(2)**2)/shp
682 z(3-jt)=2./(z1**2-z2**2)*(z1*z3+z2*sqrt(z3**2-(z1**2-z2**2)*
684 zmin=2.*pmq(3-jt)/shpr
685 zmax=1.-pmq(jt)/shpr-(sh-pmq(3-jt)**2)/(shpr*(shpr-pmq(jt)))
687 IF(
z(3-jt).LT.zmin.OR.
z(3-jt).GT.zmax) goto 340
690 ELSEIF(isub.EQ.78)
THEN
693 ELSEIF(isub.EQ.79)
THEN
697 ELSEIF(isub.LE.90)
THEN
704 ELSEIF(isub.EQ.82)
THEN
706 kcs=(-1)**int(1.5+
rlu(0))
712 ELSEIF(isub.LE.100)
THEN
716 kcs=(-1)**int(1.5+
rlu(0))
718 ELSEIF(isub.EQ.96)
THEN
722 ELSEIF(isub.LE.110)
THEN
728 ELSEIF(isub.EQ.102)
THEN
734 ELSEIF(isub.LE.120)
THEN
737 IF(
rlu(0).GT.0.5) js=2
742 ELSEIF(isub.EQ.112)
THEN
744 IF(
mint(15).EQ.21) js=2
747 kcs=isign(1,
mint(14+js))
749 ELSEIF(isub.EQ.113)
THEN
751 IF(
rlu(0).GT.0.5) js=2
754 kcs=(-1)**int(1.5+
rlu(0))
756 ELSEIF(isub.EQ.114)
THEN
758 IF(
rlu(0).GT.0.5) js=2
763 ELSEIF(isub.EQ.115)
THEN
766 ELSEIF(isub.EQ.116)
THEN
769 ELSEIF(isub.EQ.117)
THEN
773 ELSEIF(isub.LE.140)
THEN
778 ELSEIF(isub.LE.160)
THEN
783 ELSEIF(isub.EQ.142)
THEN
785 kch1=kchg(iabs(
mint(15)),1)*isign(1,
mint(15))
786 kch2=kchg(iabs(
mint(16)),1)*isign(1,
mint(16))
787 kfres=isign(37,kch1+kch2)
789 ELSEIF(isub.EQ.143)
THEN
797 IF(
mint(16).EQ.21) js=2
799 mint(20+js)=isign(37,kchg(ia,1)*
mint(17-js))
800 ja=ia+mod(ia,2)-mod(ia+1,2)
803 IF(
mint(15).NE.21) kcs=isign(1,
mint(15))
804 IF(
mint(16).NE.21) kcs=isign(1,
mint(16))
828 ELSEIF(idoc.EQ.8)
THEN
833 IF(iabs(
mint(20+jt)).LE.10.OR.
mint(20+jt).EQ.21)
k(
i,1)=3
836 IF(iabs(
k(
i,2)).LE.10.OR.
k(
i,2).EQ.21)
THEN
839 p(
i,5)=sqrt(
vint(63+mod(js+jt,2)))
842 IF(
p(ipu3,5)+
p(ipu4,5).GE.shr)
THEN
845 IF((kfa1.GT.3.AND.kfa1.NE.21).OR.(kfa2.GT.3.AND.kfa2.NE.21))
853 p(ipu3,4)=0.5*(shr+(
p(ipu3,5)**2-
p(ipu4,5)**2)/shr)
854 p(ipu3,3)=sqrt(
max(0.,
p(ipu3,4)**2-
p(ipu3,5)**2))
855 p(ipu4,4)=shr-
p(ipu3,4)
862 CALL ludbrb(ipu3,ipu4,acos(
vint(23)),
vint(24),0d0,0d0,0d0)
864 ELSEIF(idoc.EQ.9)
THEN
867 ELSEIF(idoc.EQ.11)
THEN
874 IF(iabs(
mint(20+jt)).LE.10.OR.
mint(20+jt).EQ.21)
k(
i,1)=3
878 IF(0.5*shpr*
z(jt).LE.
p(
i,5))
p(
i,5)=0.
879 pabs=sqrt(
max(0.,(0.5*shpr*
z(jt))**2-
p(
i,5)**2))
880 ptabs=pabs*sqrt(
max(0.,1.-cthe(jt)**2))
881 p(
i,1)=ptabs*cos(
phi(jt))
882 p(
i,2)=ptabs*sin(
phi(jt))
883 p(
i,3)=pabs*cthe(jt)*(-1)**(jt+1)
884 p(
i,4)=0.5*shpr*
z(jt)
888 IF(isub.EQ.8)
k(izw,2)=isign(24,
luchge(
mint(14+jt)))
892 p(izw,3)=(0.5*shpr-pabs*cthe(jt))*(-1)**(jt+1)
893 p(izw,4)=0.5*shpr*(1.-
z(jt))
894 400
p(izw,5)=-sqrt(
max(0.,
p(izw,3)**2+ptabs**2-
p(izw,4)**2))
900 p(ipu5,1)=-
p(ipu3,1)-
p(ipu4,1)
901 p(ipu5,2)=-
p(ipu3,2)-
p(ipu4,2)
902 p(ipu5,3)=-
p(ipu3,3)-
p(ipu4,3)
903 p(ipu5,4)=shpr-
p(ipu3,4)-
p(ipu4,4)
911 ELSEIF(idoc.EQ.12)
THEN
918 IF(iabs(
mint(20+jt)).LE.10.OR.
mint(20+jt).EQ.21)
k(
i,1)=3
922 IF(0.5*shpr*
z(jt).LE.
p(
i,5))
p(
i,5)=0.
923 pabs=sqrt(
max(0.,(0.5*shpr*
z(jt))**2-
p(
i,5)**2))
924 ptabs=pabs*sqrt(
max(0.,1.-cthe(jt)**2))
925 p(
i,1)=ptabs*cos(
phi(jt))
926 p(
i,2)=ptabs*sin(
phi(jt))
927 p(
i,3)=pabs*cthe(jt)*(-1)**(jt+1)
928 p(
i,4)=0.5*shpr*
z(jt)
939 p(izw,3)=(0.5*shpr-pabs*cthe(jt))*(-1)**(jt+1)
940 p(izw,4)=0.5*shpr*(1.-
z(jt))
941 p(izw,5)=-sqrt(
max(0.,
p(izw,3)**2+ptabs**2-
p(izw,4)**2))
944 k(ipu,2)=kfpr(isub,jt)
945 k(ipu,3)=
mint(83)+8+jt
946 IF(iabs(
k(ipu,2)).LE.10.OR.
k(ipu,2).EQ.21)
THEN
949 p(ipu,5)=sqrt(
vint(63+mod(js+jt,2)))
953 IF(isub.EQ.72)
k(
mint(84)+4+int(1.5+
rlu(0)),2)=-24
960 gamcm=(
p(
i1,4)+
p(
i2,4))/shr
961 bepcm=bexcm*
p(
i1,1)+beycm*
p(
i1,2)+bezcm*
p(
i1,3)
962 px=
p(
i1,1)+gamcm*(gamcm/(1.+gamcm)*bepcm-
p(
i1,4))*bexcm
963 py=
p(
i1,2)+gamcm*(gamcm/(1.+gamcm)*bepcm-
p(
i1,4))*beycm
964 pz=
p(
i1,3)+gamcm*(gamcm/(1.+gamcm)*bepcm-
p(
i1,4))*bezcm
968 sqlam=(sh-
p(ipu5,5)**2-
p(ipu6,5)**2)**2-4.*
p(ipu5,5)**2*
970 pabs=sqrt(
max(0.,sqlam/(4.*sh)))
972 sthwz=sqrt(
max(0.,1.-cthwz**2))
974 p(ipu5,1)=pabs*sthwz*cos(phiwz)
975 p(ipu5,2)=pabs*sthwz*sin(phiwz)
977 p(ipu5,4)=sqrt(pabs**2+
p(ipu5,5)**2)
981 p(ipu6,4)=sqrt(pabs**2+
p(ipu6,5)**2)
982 CALL ludbrb(ipu5,ipu6,thecm,phicm,dble(bexcm),dble(beycm),
1000 IF(kcs.EQ.-1) jc=3-
j
1001 IF(icol(kcc,1,jc).NE.0.AND.
k(ipu1,1).EQ.14)
k(ipu1,
j+3)=
1002 &
k(ipu1,
j+3)+
mint(84)+icol(kcc,1,jc)
1003 IF(icol(kcc,2,jc).NE.0.AND.
k(ipu2,1).EQ.14)
k(ipu2,
j+3)=
1004 &
k(ipu2,
j+3)+
mint(84)+icol(kcc,2,jc)
1005 IF(icol(kcc,3,jc).NE.0.AND.
k(ipu3,1).EQ.3)
k(ipu3,
j+3)=
1006 & mstu(5)*(
mint(84)+icol(kcc,3,jc))
1007 440
IF(icol(kcc,4,jc).NE.0.AND.
k(ipu4,1).EQ.3)
k(ipu4,
j+3)=
1008 & mstu(5)*(
mint(84)+icol(kcc,4,jc))
1016 IF(idoc.LE.9)
k(
i1,3)=0
1017 IF(idoc.GE.11)
k(
i1,3)=
mint(83)+2+
i
1025 k(ipu3,1)=
k(ipu3,1)+10
1026 k(ipu4,1)=
k(ipu4,1)+10