37 IMPLICIT DOUBLE PRECISION(
a-h,o-
z)
40 parameter(conv=.38935d0)
41 parameter(pi=3.141592654d0,
45 parameter(thousa = 1000.d0)
48 COMMON /outlev/ioutpo,ioutpa,iouxev,ioucol
51 COMMON /pomtyp/ipim,icon,isig,lmax,mmax,
nmax,difel,difnu
52 common/pompar/alfa,alfap,
a,c,ak
53 COMMON /sigma/sigsof,bs,zsof,sighar,bh,zhar,sigtrp,bt,ztrp,
57 CHARACTER*8 projty,targty
60 COMMON /user1/
title,projty,targty
61 COMMON /user2/cmener,sdfrac,ptlar,istruf,isingd,idubld
63 COMMON /strufu/istrum,istrut
68 COMMON /collpo/
s,ptthr,ptthr2
71 common/collis/spo,ijproj,ijtar,pttpo,pttpo2,iophrd,ijprlu,ijtalu
72 COMMON /haqqap/ aqqal,aqqpd,nqqal,nqqpd
76 dimension xsqsj(21),xxhhj4(21)
81 DATA xsqsj/0.005,0.01,0.02,0.035,0.053,
82 * 0.1,0.2,0.35,0.54,1.,2.,5.,
83 *10.,20.,40.,100.,200.,400.,1000.,2000.,4000./
86 DATA sqs/1.,2.,3.,4.,5.,10.,20.,30.,40.,100.,200.,500.,1000./
95 go to(10,20,30,40,50,60,70,80,90,100),isig
98 WRITE(6,*)
' This value of ISIG no longer available ISIG=',isig
104 WRITE(6,*)
' This value of ISIG no longer available ISIG=',isig
109 WRITE(6,*)
' This value of ISIG no longer available ISIG=',isig
116 WRITE(6,*)
' This value of ISIG no longer available ISIG=',isig
123 WRITE(6,*)
' This value of ISIG no longer available ISIG=',isig
130 WRITE(6,*)
' This value of ISIG no longer available ISIG=',isig
137 WRITE(6,*)
' This value of ISIG no longer available ISIG=',isig
142 WRITE(6,*)
' This value of ISIG no longer available ISIG=',isig
146 WRITE(6,*)
' This value of ISIG no longer available ISIG=',isig
175 IF(abs(ptthr-three).LT.eps)
THEN
176 WRITE(6,*)
' PTTHR=3. not available in dpmjet25'
177 WRITE(6,*)
' WARNING: no model parameter set available'
178 WRITE(6,*)
' for this combination of PTCUT and ISTRUF'
179 WRITE(6,*)
' (initialization using default values)'
190 IF(abs(ptthr-two).LT.eps)
THEN
191 WRITE(6,*)
' PTTHR=2. not available in dpmjet25'
192 WRITE(6,*)
' WARNING: no model parameter set available'
193 WRITE(6,*)
' for this combination of PTCUT and ISTRUF'
194 WRITE(6,*)
' (initialization using default values)'
211 WRITE(6,*)
' ISTRUT=1 (PTTHR=2.1+0.15*(LOG10(ECM/50.))**3)',
212 *
'not available in dpmjet25'
213 ptthr=2.1+0.15*(log10(ecm/50.))**3
215 WRITE(6,*)
' WARNING: no model parameter set available'
216 WRITE(6,*)
' for this combination of PTCUT and ISTRUF'
217 WRITE(6,*)
' (initialization using default values)'
237 ptthr=2.5+0.12*(log10(ecm/50.))**3
239 IF( istruf.EQ.9 )
THEN
240 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
241 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
243 ELSEIF( istruf.EQ.10 )
THEN
244 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
245 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
247 ELSEIF( istruf.EQ.11 )
THEN
248 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
249 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
251 ELSEIF( istruf.EQ.12 )
THEN
252 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
253 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
255 ELSEIF( istruf.EQ.13 )
THEN
256 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
257 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
259 ELSEIF( istruf.EQ.14 )
THEN
260 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
261 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
263 ELSEIF( istruf.EQ.15 )
THEN
264 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
265 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
268 ELSEIF( istruf.EQ.16 )
THEN
269 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
270 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
273 ELSEIF( istruf.EQ.17 )
THEN
274 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
275 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
277 ELSEIF( istruf.EQ.18 )
THEN
278 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
279 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
281 ELSEIF( istruf.EQ.19 )
THEN
282 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
283 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
285 ELSEIF( istruf.EQ.20 )
THEN
286 WRITE(6,*)
' ISTRUT=2 (PTTHR=2.5+0.12*(LOG10(ECM/50.))**3)',
287 *
'and ISTRUF= ',istruf ,
' not available in dpmjet25'
290 ELSEIF( istruf.EQ.21 )
THEN
299 ELSEIF( istruf.EQ.22 )
THEN
308 ELSEIF( istruf.EQ.23 )
THEN
318 WRITE(6,*)
' WARNING: no model parameter set available'
319 WRITE(6,*)
' for this combination of PTCUT and ISTRUF'
320 WRITE(6,*)
' (initialization using default values)'
350 sigsof=
a*
s**(alfa-1.)
356 IF(istruf.EQ.21)ak=2.
359 * sighar=ak*0.1*(
s-2450.)**0.35
360 IF(ecm.GE.thousa*xsqsj(2))
THEN
363 IF(ecm.LT.xsqsj(iii)*thousa.AND.
364 * ecm.GE.thousa*xsqsj(i))
THEN
365 dsq=ecm-thousa*xsqsj(i)
366 ddsq=thousa*(xsqsj(iii)-xsqsj(i))
367 dhs=(xxhhj4(iii)-xxhhj4(i))
368 sighar=ak*(xxhhj4(i)+dhs*dsq/ddsq)*0.5
384 bsdca=bsdoca+2.*alsca*alns
385 sigtrp=g3ca*gaca*
log(
s/10.)/(8.*3.14*bsdca)
386 IF (sigtrp.LT.0.d0)sigtrp=0.01
389 alo1sq=(
log(
s/400.))**2
390 alo2sq=(
log(25./
s))**2
391 alo3sq=(
log(5./20.))**2
392 sigloo=
a*gaca**2*(alo1sq+alo2sq-2.*alo3sq)/(32.*3.14*bddca)
432 IMPLICIT DOUBLE PRECISION(
a-h,o-
z)
435 CHARACTER*8 projty,targty
438 COMMON /user1/
title,projty,targty
439 COMMON /user2/cmener,sdfrac,ptlar,istruf,isingd,idubld
443 COMMON /collpo/
s,ptthr,ptthr2
446 common/collis/spo,ijproj,ijtar,pttpo,pttpo2,iophrd,ijprlu,ijtalu
447 COMMON /strufu/istrum,istrut
452 parameter(epsil=1.
d-4,
457 & 0.000000
e+00,0.137854
e-04, .02, .13, .37, 1.32,
458 & 3.88, 8.02, 13.15, 24.32, 43.43, 79.69, 113.13,
459 & 147.5, 180.47, 221.01, 250.37,
460 & 279.4, 320.1, 349.6, 381.6,
462 & .000000
e+00, .494767
e-05, .02, .14, .41,
463 & 1.48, 4.17, 7.92, 11.90, 19.03, 28.59, 42.36,
464 & 52.78, 62.86, 72.65, 85.61, 95.97,
465 & 96., 96., 96., 96.,
468 & 0.517461
e-05, .02, .14, .42, 1.49, 4.14,
469 & 7.87, 11.93, 19.58, 30.67, 48.39, 63.08,
470 & 78.1, 93.28, 114.33, 132.24,
471 & 133., 133., 133., 133.,
474 & 0.717097
e-05, .03, .19, .54, 1.91, 5.33, 10.11,
475 & 16.16, 24.21, 36.41, 54.21, 67.92, 81.44,
476 & 94.81,112.9, 127.63,
477 & 128., 128., 128., 128.,
480 & 0.761464
e-05, .02, .17, .47, 1.56, 4.19,
481 & 7.76, 11.48, 18.11, 26.97, 39.82, 49.86, 59.35,
482 & 68.88, 81.65, 91.94,
483 & 92., 92., 92., 92.,
486 & .620779
e-05, .02, .12, .34, 1.19, 3.27,
487 & 6.16, 9.27, 14.99, 23.2, 36.85, 49.45,
488 & 64.43, 82.38, 112.06, 140.36,
489 & 141., 141., 141., 141.,
492 & .620779
e-05, .01, .05, .14, 0.55, 1.87,
493 & 4.29, 7.49, 14.81, 27.8, 55.99, 77.49,
494 & 105.98,138.48, 189.33, 236.37,
495 & 294., 395., 496., 629.,
498 & .620779
e-05, .01, .10, .31, 1.16, 3.76,
499 & 8.31, 14.16, 27.11, 49.3, 90.93,129.77,
500 & 174.16,223.83, 300.20, 370.00,
501 & 455., 600., 746., 936.,
504 & .620779
e-05, .01, .08, .27, 1.17, 4.15,
505 & 9.60, 16.75, 32.88, 61.1,125.98,169.87,
506 & 233.75,308.22, 426.95, 537.90,
507 & 673., 898., 1112., 1379./
510 IF( abs(ptthr-three).LT.epsil )
THEN
511 WRITE(6,*)
' ERROR RDXSEC: invalid pdf No. ',istruf
513 ELSEIF( abs(ptthr-two).LT.epsil )
THEN
514 WRITE(6,*)
' ERROR RDXSEC: invalid pdf No. ',istruf
516 ELSEIF( istrut.EQ.1 )
THEN
517 WRITE(6,*)
' ERROR RDXSEC: invalid pdf No. ',istruf
519 ELSEIF( istrut.EQ.2 )
THEN
520 IF( (istruf.GE.9).AND.(istruf.LE.20) )
THEN
521 WRITE(6,*)
' ERROR RDXSEC: invalid pdf No. ',istruf
523 ELSEIF( (istruf.GE.21).AND.(istruf.LE.23) )
THEN
525 nxs = 21*(istruf-15)+i
529 WRITE(6,*)
' ERROR RDXSEC: invalid pdf No. ',istruf
533 WRITE(6,*)
' ERROR RDXSEC: PTCUT ',ptthr,
' not supported ***'
544 IMPLICIT DOUBLE PRECISION(
a-h,o-
z)
546 COMMON /pomene/poen(28),poen1(28),poen2(28),nestep
547 DATA poen/20.d0,50.d0,100.d0,200.d0,500.d0,
549 * 2000.d0,3000.d0,4000.d0,6000.d0,8000.d0,10000.d0,
550 *15000.d0,20000.d0,30000.d0,40000.d0,60000.d0,
551 *80000.d0,100000.d0,150000.d0,200000.d0,300000.d0
552 *,400000.d0,600000.d0,800000.d0,1000000.d0,2000000.d0/
553 DATA poen1/5.d0,30.d0,70.d0,150.d0,300.d0,
554 * 700.d0,1200.d0,1700.d0,
555 * 2500.d0,3500.d0,5000.d0,7000.d0,9000.d0,
556 *12000.d0,17000.d0,25000.d0,35000.d0,50000.d0,
557 *70000.d0,90000.d0,120000.d0,170000.d0,250000.d0,
558 *250000.d0,500000.d0,700000.d0,900000.d0,1500000.d0/
559 DATA poen2/30.d0,70.d0,150.d0,300.d0,
560 * 700.d0,1200.d0,1700.d0,2500.d0,
561 * 3500.d0,5000.d0,7000.d0,9000.d0,12000.d0,
562 *17000.d0,25000.d0,35000.d0,50000.d0,70000.d0,
563 *90000.d0,120000.d0,170000.d0,250000.d0,350000.d0,
564 *500000.d0,700000.d0,900000.d0,1500000.d0,3000000.d0/
572 IMPLICIT DOUBLE PRECISION(
a-h,o-
z)
587 COMMON /pomene/poen(28),poen1(28),poen2(28),nestep
588 COMMON /pomtab/ipomta
590 parameter(mxpa25=30,mxpa26=mxpa25+1,mxpa13=13)
591 parameter(mxpa50=250,mxpa51=mxpa50+1)
592 parameter(mxpu50=100,mxpu51=mxpu50+1)
594 COMMON /polmn/plmn(0:mxpa25,0:mxpa50,0:mxpa13),
595 * plmncu(0:mxpa25,0:mxpa50,0:mxpa13)
596 COMMON /polmn1/ plmnee(0:mxpa25,0:mxpu50,0:mxpa13,28)
609 CHARACTER dpmdirname*400, pomfilename*400
610 CALL getenv(
'G4DPMJET2_5DATA',dpmdirname)
611 pomfilename = dpmdirname(1:len_trim(dpmdirname))//
613 OPEN(
unit=iunit,file=pomfilename,
status=
'OLD',err=99)
616 IF (ipomta.EQ.0)
THEN
623 plmnee(jj,kk,ll,ii)=plmncu(jj,kk,ll)
627 WRITE(iunit,7102) nestep
629 WRITE(iunit,7101) poen(ii), poen1(ii), poen2(ii)
630 WRITE(iunit,101)(((plmnee(jj,kk,ll,ii),ll=0,mxpa13),
631 * kk=0,mxpu50),jj=0,mxpa25)
637 ELSEIF (ipomta.EQ.1)
THEN
638 READ(iunit,7102) nestep
641 READ(iunit,7101) poen(ii), poen1(ii), poen2(ii)
642 WRITE(6,7101) poen(ii), poen1(ii), poen2(ii)
643 READ(iunit,101)(((plmnee(jj,kk,ll,ii),ll=0,mxpa13),
644 * kk=0,mxpu50),jj=0,mxpa25)
652 WRITE(6,
'(A)')
'Error in PRBLM2 : file pomtab.dat ERROR'
678 IMPLICIT DOUBLE PRECISION(
a-h,o-
z)
680 parameter(
zero=0.d0,
one=1.d0)
681 parameter(conv=0.38935d0)
682 parameter(pi=3.141592654d0)
683 parameter(mxpa25=30,mxpa26=mxpa25+1,mxpa13=13)
685 parameter(mxpa50=250,mxpa51=mxpa50+1)
692 parameter(mxlmn=5,lsqrt=.true.)
693 DOUBLE PRECISION dtiny
697 parameter(tiny=1.2
d-38,dtiny=1.
d-70,tin=1.
d-22,tinexp=-700.d0)
700 parameter(tinyex = -48.d0)
703 COMMON /polmn/plmn(0:mxpa25,0:mxpa50,0:mxpa13),
704 * plmncu(0:mxpa25,0:mxpa50,0:mxpa13)
705 COMMON /polmn0/pdifr,phard,psoft,alfah,betah,
706 * sigtot,sigqel,sigel,sigine,sighin,sigd,sigdd
709 COMMON /pomtyp/ipim,icon,isig,lmax,mmax,
nmax,difel,difnu
710 COMMON /sigma/sigsof,bs,zsof,sighar,bh,zhar,sigtrp,bt,ztrp,
712 common/pompar/alfa,alfap,
a,c,ak
713 COMMON /singdi/silmsd,sigdi
715 COMMON /outlev/ioutpo,ioutpa,iouxev,ioucol
718 CHARACTER*8 projty,targty
721 COMMON /user1/
title,projty,targty
722 COMMON /user2/cmener,sdfrac,ptlar,istruf,isingd,idubld
724 DOUBLE PRECISION sig,sigp,sigm,sign,sigo
725 dimension sig(0:mxpa25,0:mxpa50,0:mxpa13),
726 &sigp(0:mxpa25,0:mxpa50,0:mxpa13),sigm(0:mxpa25,0:mxpa50,0:mxpa13),
727 &sign(0:mxpa25,0:mxpa50,0:mxpa13),sigo(0:mxpa25,0:mxpa50,0:mxpa13)
728 dimension xpnt(mxpa96),wght(mxpa96),
729 &ssoft(0:mxpa25),shard(0:mxpa50),strpl(0:mxpa25)
731 dimension fak(0:mxpa13),cmbin(0:mxpa13,0:mxpa13)
733 & expsop,expsoh,exmsop,exmsoh,exnsop,exnsoh,exosop,exosoh,
734 & exphap,exphah,exmhap,exmhah,exnhap,exnhah,exohap,exohah,
735 & exptrp,exptrh,exmtrp,exmtrh,exntrp,exntrh,exotrp,exotrh,
736 & explop,exploh,exmlop,exmloh,exnlop,exnloh,exolop,exoloh,
737 & expexh,exmexh,exnexh,exoexh,expexp,exmexp,exnexp,exoexp
738 DOUBLE PRECISION fapsof,famsof,fansof,faosof,
739 & faphar,famhar,fanhar,faohar,
740 & faptrp,famtrp,fantrp,faotrp,
741 & faploo,famloo,fanloo,faoloo
742 DOUBLE PRECISION denom,denomi,xpntk,wghtk,rmxlmn
743 & ,sigsum,siginl,sighri
748 IF(icon/10.EQ.4)
nmax=2
749 IF(icon/10.EQ.5)
nmax=1
752 IF(
nmax.GT.mxpa13)
THEN
753 WRITE(6,*)
' arrays limit NMAX set to' , mxpa13
756 IF( mmax.GT.mxpa50)
THEN
757 WRITE(6,*)
' arrays limit MMAX set to' , mxpa50
760 IF( lmax.GT.mxpa25)
THEN
761 WRITE(6,*)
' arrays limit LMAX set to' , mxpa25
769 nnmaxi=(mxpa13-nmaxi)/(1+nmaxi)
772 ELSEIF(
nmax.EQ.2)
THEN
776 ELSEIF(
nmax.EQ.1)
THEN
780 ELSEIF(
nmax.LE.0)
THEN
799 IF(icon/10.EQ.4)
nmax=2
800 IF(icon/10.EQ.5)
nmax=1
853 IF(alalam.LE.1.
d-2)
THEN
862 IF(ecm.LT.2000.d0)
THEN
872 IF(ioutpo.GE.0)
WRITE (6,*)
' ALAM,REDU= ',alam,redu
878 zharp=(1.+alam)**2*zhar
879 zsofp=(1.+alam)**2*zsof
880 zloop=(1.+alam)**2*zloo * redu
881 zharm=(1.-alam)**2*zhar
882 zsofm=(1.-alam)**2*zsof
883 zloom=(1.-alam)**2*zloo * redu
884 zharn=(1.-alam**2)*zhar
885 zsofn=(1.-alam**2)*zsof
886 zloon=(1.-alam**2)*zloo * redu
887 zharo=(1.-alam**2)*zhar
888 zsofo=(1.-alam**2)*zsof
889 zlooo=(1.-alam**2)*zloo * redu
891 ztrpp=(1.+alam)**3*ztrp * redu
892 ztrpm=(1.-alam)**3*ztrp * redu
893 ztrpn=(1.-alam**2)*(1.+alam)*ztrp * redu
894 ztrpo=(1.-alam**2)*(1.-alam)*ztrp * redu
905 fapsof=fapsof*
sqrt( zsofp/float(l))
906 famsof=famsof*
sqrt( zsofm/float(l))
907 fansof=fansof*
sqrt( zsofn/float(l))
908 faosof=faosof*
sqrt( zsofo/float(l))
909 IF ( fapsof .LT.dtiny ) fapsof=0.
910 IF ( famsof .LT.dtiny ) famsof=0.
911 IF ( fansof .LT.dtiny ) fansof=0.
912 IF ( faosof .LT.dtiny ) faosof=0.
913 ELSEIF(.NOT.lsqrt)
THEN
914 fapsof=fapsof*zsofp/float(l)
915 famsof=famsof*zsofm/float(l)
916 fansof=fansof*zsofn/float(l)
917 faosof=faosof*zsofo/float(l)
918 IF (fapsof.LT.dtiny ) fapsof=0.
919 IF (famsof.LT.dtiny ) famsof=0.
920 IF (fansof.LT.dtiny ) fansof=0.
921 IF (faosof.LT.dtiny ) faosof=0.
931 faphar=faphar*
sqrt( zharp/float(m) )
932 famhar=famhar*
sqrt( zharm/float(m) )
933 fanhar=fanhar*
sqrt( zharn/float(m) )
934 faohar=faohar*
sqrt( zharo/float(m) )
935 IF ( fapsof*faphar .LT.dtiny ) faphar=0.
936 IF ( famsof*famhar .LT.dtiny ) famhar=0.
937 IF ( fansof*fanhar .LT.dtiny ) fanhar=0.
938 IF ( faosof*faohar .LT.dtiny ) faohar=0.
939 ELSEIF(.NOT.lsqrt)
THEN
940 faphar=faphar*zharp/float(m)
941 famhar=famhar*zharm/float(m)
942 fanhar=fanhar*zharn/float(m)
943 faohar=faohar*zharo/float(m)
944 IF (fapsof*faphar.LT.dtiny ) faphar=0.
945 IF (famsof*famhar.LT.dtiny ) famhar=0.
946 IF (fansof*fanhar.LT.dtiny ) fanhar=0.
947 IF (faosof*faohar.LT.dtiny ) faohar=0.
956 faptrp=-faptrp*
sqrt( ztrpp/float(
n) )
957 famtrp=-famtrp*
sqrt( ztrpm/float(
n) )
958 fantrp=-fantrp*
sqrt( ztrpn/float(
n) )
959 faotrp=-faotrp*
sqrt( ztrpo/float(
n) )
960 IF (abs(faptrp*fapsof*faphar).LT.dtiny ) faptrp=0.
961 IF (abs(famtrp*famsof*famhar).LT.dtiny ) famtrp=0.
962 IF (abs(fantrp*fansof*fanhar).LT.dtiny ) fantrp=0.
963 IF (abs(faotrp*faosof*faohar).LT.dtiny ) faotrp=0.
964 ELSEIF(.NOT.lsqrt)
THEN
965 faptrp=-faptrp*ztrpp/float(
n)
966 famtrp=-famtrp*ztrpm/float(
n)
967 fantrp=-fantrp*ztrpn/float(
n)
968 faotrp=-faotrp*ztrpo/float(
n)
969 IF (abs(faptrp*fapsof*faphar).LT.dtiny ) faptrp=0.
970 IF (abs(famtrp*famsof*famhar).LT.dtiny ) famtrp=0.
971 IF (abs(fantrp*fansof*fanhar).LT.dtiny ) fantrp=0.
972 IF (abs(faotrp*faosof*faohar).LT.dtiny ) faotrp=0.
978 IF(
nmax.LE.2 .AND.
n.EQ.1 .AND. nn.EQ.1 ) go to 750
985 faploo=-faploo*
sqrt( zloop/float(nn))
986 famloo=-famloo*
sqrt( zloom/float(nn))
987 fanloo=-fanloo*
sqrt( zloon/float(nn))
988 faoloo=-faoloo*
sqrt( zlooo/float(nn))
989 IF(abs(faploo*faptrp*fapsof*faphar).LT.dtiny )faploo=0.
990 IF(abs(famloo*famtrp*famsof*famhar).LT.dtiny )famloo=0.
991 IF(abs(fanloo*fantrp*fansof*fanhar).LT.dtiny )fanloo=0.
992 IF(abs(faoloo*faotrp*faosof*faohar).LT.dtiny )faoloo=0.
993 ELSEIF(.NOT.lsqrt)
THEN
994 faploo=-faploo*zloop/float(nn)
995 famloo=-famloo*zloom/float(nn)
996 fanloo=-fanloo*zloon/float(nn)
997 faoloo=-faoloo*zlooo/float(nn)
998 IF(abs(faploo*faptrp*fapsof*faphar).LT.dtiny )faploo=0.
999 IF(abs(famloo*famtrp*famsof*famhar).LT.dtiny )famloo=0.
1000 IF(abs(fanloo*fantrp*fansof*fanhar).LT.dtiny )fanloo=0.
1001 IF(abs(faoloo*faotrp*faosof*faohar).LT.dtiny )faoloo=0.
1005 IF(l.EQ.0.AND.m.EQ.0.AND.
n.EQ.0.AND.nn.EQ.0) go to 750
1007 denom=dble(m)/dble(bh)+dble(l)/dble(bs)+dble(
n)/dble(bt)
1008 & +dble(nn)/dble(bt)
1013 IF ( (m+l+
n+nn) .LE. mxlmn )
THEN
1018 rmxlmn = dble(m+l+
n+nn) /dble(mxlmn)
1020 wghtk= dble(wght(k)) * xpntk**(rmxlmn-1.)
1021 denomi= denom / rmxlmn
1024 exposp=-zsofp*xpntk**(1./(denomi*dble(bs)))
1025 exposm=-zsofm*xpntk**(1./(denomi*dble(bs)))
1026 exposn=-zsofn*xpntk**(1./(denomi*dble(bs)))
1027 exposo=-zsofo*xpntk**(1./(denomi*dble(bs)))
1029 expohp=-zharp*xpntk**(1./(denomi*dble(bh)))
1030 expohm=-zharm*xpntk**(1./(denomi*dble(bh)))
1031 expohn=-zharn*xpntk**(1./(denomi*dble(bh)))
1032 expoho=-zharo*xpntk**(1./(denomi*dble(bh)))
1034 expotp=+ztrpp*xpntk**(1./(denomi*dble(bt)))
1035 expotm=+ztrpm*xpntk**(1./(denomi*dble(bt)))
1036 expotn=+ztrpn*xpntk**(1./(denomi*dble(bt)))
1037 expoto=+ztrpo*xpntk**(1./(denomi*dble(bt)))
1039 expolp=+zloop*xpntk**(1./(denomi*dble(bt)))
1040 expolm=+zloom*xpntk**(1./(denomi*dble(bt)))
1041 expoln=+zloon*xpntk**(1./(denomi*dble(bt)))
1042 expolo=+zlooo*xpntk**(1./(denomi*dble(bt)))
1044 IF(ioutpo.GE.7)
THEN
1046 *
' K=',k,
' EXPOS/H=',exposp,expohp,
' DENOMI/BH=',denomi,bh
1048 *
' K=',k,
' EXPOS/H=',exposm,expohm,
' DENOMI/BH=',denomi,bh
1050 *
' K=',k,
' EXPOS/H=',exposn,expohn,
' DENOMI/BH=',denomi,bh
1052 *
' K=',k,
'XPNT=',xpntk,
'WGHT=',wghtk,
'DENO=',denomi
1058 IF( exposp .GT. tinexp)
THEN
1059 expsoh=
exp(0.5d00*exposp)
1060 exmsoh=
exp(0.5d00*exposm)
1061 exnsoh=
exp(0.5d00*exposn)
1062 exosoh=
exp(0.5d00*exposo)
1074 IF( expohp .GT. tinexp)
THEN
1075 exphah=
exp(0.5d00*expohp)
1076 exmhah=
exp(0.5d00*expohm)
1077 exnhah=
exp(0.5d00*expohn)
1078 exohah=
exp(0.5d00*expoho)
1091 IF( expotp .GT. tinexp)
THEN
1092 exptrh=
exp(0.5d00*expotp)
1093 exmtrh=
exp(0.5d00*expotm)
1094 exntrh=
exp(0.5d00*expotn)
1095 exotrh=
exp(0.5d00*expoto)
1106 ELSEIF(
nmax.LE.2)
THEN
1107 exptrh= 1 + 0.5*expotp
1108 exmtrh= 1 + 0.5*expotm
1109 exntrh= 1 + 0.5*expotn
1110 exotrh= 1 + 0.5*expoto
1118 IF( expolp .GT. tinexp)
THEN
1119 exploh=
exp(0.5d00*expolp)
1120 exmloh=
exp(0.5d00*expolm)
1121 exnloh=
exp(0.5d00*expoln)
1122 exoloh=
exp(0.5d00*expolo)
1133 ELSEIF(
nmax.EQ.2 )
THEN
1134 exploh= 1 + 0.5*expolp
1135 exmloh= 1 + 0.5*expolm
1136 exnloh= 1 + 0.5*expoln
1137 exoloh= 1 + 0.5*expolo
1142 ELSEIF(
nmax.LE.1 )
THEN
1153 expexh = expsoh *exphah *exptrh *exploh
1154 exmexh = exmsoh *exmhah *exmtrh *exmloh
1155 exnexh = exnsoh *exnhah *exntrh *exnloh
1156 exoexh = exosoh *exohah *exotrh *exoloh
1157 expexp = expsop *exphap *exptrp *explop
1158 exmexp = exmsop *exmhap *exmtrp *exmlop
1159 exnexp = exnsop *exnhap *exntrp *exnlop
1160 exoexp = exosop *exohap *exotrp *exolop
1162 IF( (
nmax.LE.2 .AND.
n.EQ.1 ) .OR.
1163 * (
nmax.EQ.2 .AND. nn.EQ.1 ) .OR.
1165 sigp(l,m,nnn)=sigp(l,m,nnn)+expsop *exphap *wghtk
1166 sigm(l,m,nnn)=sigm(l,m,nnn)+exmsop *exmhap *wghtk
1167 sign(l,m,nnn)=sign(l,m,nnn)+exnsop *exnhap *wghtk
1168 sigo(l,m,nnn)=sigo(l,m,nnn)+exosop *exohap *wghtk
1170 sigp(l,m,nnn)=sigp(l,m,nnn)+expexp*wghtk
1171 sigm(l,m,nnn)=sigm(l,m,nnn)+exmexp*wghtk
1172 sign(l,m,nnn)=sign(l,m,nnn)+exnexp*wghtk
1173 sigo(l,m,nnn)=sigo(l,m,nnn)+exoexp*wghtk
1178 IF(l.EQ.1.AND.m.EQ.0.AND.
n.EQ.0.AND.nn.EQ.0)
THEN
1180 IF ( (m+l+
n+nn) .GT. mxlmn )
THEN
1181 WRITE(6,*)
' MXLMN too low ' , mxlmn,m,l,
n,nn
1184 wghfac = wghtk/xpntk *pi4/denomi
1185 IF (
nmax.GE.3 )
THEN
1186 sigele = sigele + wghfac *
1187 * 0.0625*( 1.-expexh + 1.-exmexh
1188 * +1.-exnexh + 1.-exoexh )**2
1190 silmsd = silmsd + wghfac *
1191 * 0.125*(expexh -exmexh)**2
1192 silmdd = silmdd + wghfac *
1193 * 0.0625*(expexh+exmexh-exnexh-exoexh)**2
1194 ELSEIF(
nmax.LE.2 )
THEN
1195 sigele = sigele + wghfac *
1196 * 0.0625*( ( 1.-expexh + 1.-exmexh
1197 * +1.-exnexh + 1.-exoexh
1200 * +(1.-exptrh)*(1-exploh) *expsoh *exphah
1201 * +(1.-exmtrh)*(1-exmloh) *exmsoh *exmhah
1202 * +(1.-exntrh)*(1-exnloh) *exnsoh *exnhah
1203 * +(1.-exotrh)*(1-exoloh) *exosoh *exohah)**2
1205 * - ( (2.-exptrh-exploh) *expsoh *exphah
1206 * +(2.-exmtrh-exmloh) *exmsoh *exmhah
1207 * +(2.-exntrh-exnloh) *exnsoh *exnhah
1208 * +(2.-exotrh-exoloh) *exosoh *exohah ) **2)
1210 silmsd = silmsd + wghfac *
1211 * 0.125*( ( expexh -exmexh
1213 * -(1.-exptrh)*(1-exploh) *expsoh*exphah
1214 * +(1.-exmtrh)*(1-exmloh) *exmsoh*exmhah )**2
1216 * -( (2.-exptrh-exploh) *expsoh *exphah
1217 * -(2.-exmtrh-exmloh) *exmsoh*exmhah ) **2)
1218 silmdd = silmdd + wghfac *
1219 * 0.0625*( (expexh+exmexh-exnexh-exoexh
1221 * -(1.-exptrh)*(1-exploh) *expsoh *exphah
1222 * -(1.-exmtrh)*(1-exmloh) *exmsoh *exmhah
1223 * +(1.-exntrh)*(1-exnloh) *exnsoh *exnhah
1224 * +(1.-exotrh)*(1-exoloh) *exosoh *exohah)**2
1226 * - ( (2.-exptrh-exploh) *expsoh *exphah
1227 * +(2.-exmtrh-exmloh) *exmsoh *exmhah
1228 * -(2.-exntrh-exnloh) *exnsoh *exnhah
1229 * -(2.-exotrh-exoloh) *exosoh *exohah ) **2)
1231 IF(
nmax.NE.2 )
THEN
1232 sigtot=sigtot+2.*wghfac*
1233 * 0.25*( 1.-expexh + 1.-exmexh +
1234 * 1.-exnexh + 1.-exoexh )
1235 sigine = sigine + wghfac *
1236 * 0.25*( 1.-expexp + 1.-exmexp +
1237 * 1.-exnexp + 1.-exoexp )
1239 sigsin=sigsin+ wghfac *
1240 * 0.25*( (exphap-expexp)
1243 * +(exohap-exoexp) )
1245 sighin=sighin+ wghfac*
1246 * 0.25*( 1.-exphap + 1.-exmhap +
1247 * 1.-exnhap + 1.-exohap )
1248 ELSEIF(
nmax.EQ.2 )
THEN
1249 sigtot=sigtot+2.*wghfac*
1250 * 0.25*( 1.-expexh + 1.-exmexh +
1251 * 1.-exnexh + 1.-exoexh
1254 * +(1.-exptrh)*(1-exploh) *expsoh *exphah
1255 * +(1.-exmtrh)*(1-exmloh) *exmsoh *exmhah
1256 * +(1.-exntrh)*(1-exnloh) *exnsoh *exnhah
1257 * +(1.-exotrh)*(1-exoloh) *exosoh *exohah )
1258 sigine = sigine + wghfac *
1259 * 0.25*( 1.-expexp + 1.-exmexp +
1260 * 1.-exnexp + 1.-exoexp
1263 * +(1.-exptrp)*(1-explop) *expsop *exphap
1264 * +(1.-exmtrp)*(1-exmlop) *exmsop *exmhap
1265 * +(1.-exntrp)*(1-exnlop) *exnsop *exnhap
1266 * +(1.-exotrp)*(1-exolop) *exosop *exohap )
1268 sigsin=sigsin+ wghfac *
1269 * 0.25*( (exphap-expexp)
1274 * +(1.-exptrp)*(1-explop) *expsop *exphap
1275 * +(1.-exmtrp)*(1-exmlop) *exmsop *exmhap
1276 * +(1.-exntrp)*(1-exnlop) *exnsop *exnhap
1277 * +(1.-exotrp)*(1-exolop) *exosop *exohap)
1279 sighin=sighin+ wghfac*
1280 * 0.25*( 1.-exphap + 1.-exmhap +
1281 * 1.-exnhap + 1.-exohap )
1285 IF(
nmax.GE.3 )
THEN
1286 sighmd=sighmd + wghfac *
1287 * 0.25*( (exptrp-1.)*expexp
1288 * +(exmtrp-1.)*exmexp
1289 * +(exntrp-1.)*exnexp
1290 * +(exotrp-1.)*exoexp)
1292 sighmd=sighmd + wghfac *
1293 * 0.25*( expotp * expsop*exphap
1294 * +expotm * exmsop*exmhap
1295 * +expotn * exnsop*exnhap
1296 * +expoto * exosop*exohap )
1298 IF(
nmax.GE.3 )
THEN
1299 sihmdd=sihmdd + wghfac *
1300 * 0.25*( (explop-1.)*expexp
1301 * +(exmlop-1.)*exmexp
1302 * +(exnlop-1.)*exnexp
1303 * +(exolop-1.)*exoexp)
1304 ELSEIF (
nmax.EQ.2 )
THEN
1305 sihmdd=sihmdd + wghfac *
1306 * 0.25*( expolp * expsop*exphap
1307 * +expolm * exmsop*exmhap
1308 * +expoln * exnsop*exnhap
1309 * +expolo * exosop*exohap )
1324 IF(abs(faphar*fapsof*faptrp*faploo*sigp(l,m,nnn)).LT.dtiny)
1328 sigp(l,m,nnn)=faphar*fapsof*faptrp*faploo*sigp(l,m,nnn)
1329 * * abs(faphar*fapsof*faptrp*faploo)/denomi*pi4
1330 ELSEIF(.NOT.lsqrt)
THEN
1331 sigp(l,m,nnn)=faphar*fapsof*faptrp*faploo*sigp(l,m,nnn)
1334 IF(abs(famhar*famsof*famtrp*famloo*sigm(l,m,nnn)).LT.dtiny)
1338 sigm(l,m,nnn)=famhar*famsof*famtrp*famloo*sigm(l,m,nnn)
1339 * * abs( famhar*famsof*famtrp*famloo)/denomi*pi4
1340 ELSEIF(.NOT.lsqrt)
THEN
1341 sigm(l,m,nnn)=famhar*famsof*famtrp*famloo*sigm(l,m,nnn)
1344 IF(abs(fanhar*fansof*fantrp*fanloo*sign(l,m,nnn)).LT.dtiny)
1348 sign(l,m,nnn)=fanhar*fansof*fantrp*fanloo*sign(l,m,nnn)
1349 * * abs( fanhar*fansof*fantrp*fanloo)/denomi*pi4
1350 ELSEIF(.NOT.lsqrt)
THEN
1351 sign(l,m,nnn)=fanhar*fansof*fantrp*fanloo*sign(l,m,nnn)
1354 IF(abs(faohar*faosof*faotrp*faoloo*sigo(l,m,nnn)).LT.dtiny)
1358 sigo(l,m,nnn)=faohar*faosof*faotrp*faoloo*sigo(l,m,nnn)
1359 * * abs( faohar*faosof*faotrp*faoloo/denomi)*pi4
1360 ELSEIF(.NOT.lsqrt)
THEN
1361 sigo(l,m,nnn)=faohar*faosof*faotrp*faoloo*sigo(l,m,nnn)
1372 nnnmax=nmaxi+(nmaxi+1)*nnmaxi
1376 sig(l,m,nnn)=(sigp(l,m,nnn)+sigm(l,m,nnn)+
1377 * sign(l,m,nnn)+sigo(l,m,nnn) )/4.
1388 IF(
nmax.LE.2 .AND.
n.EQ.1 .AND. nn.EQ.1 ) go to 4
1390 sigsum=sigsum + sig(l,m,nnn)
1392 IF(m.EQ.0.OR.l.GE.1) sigsme=sigsme + sig(l,m,nnn)
1393 shard(m)=shard(m)+sig(l,m,nnn)
1394 ssoft(l)=ssoft(l)+sig(l,m,nnn)
1395 strpl(
n)=strpl(
n)+sig(l,m,nnn)
1396 siginl = siginl + sig(l,m,nnn)
1397 IF(m.GE.1) sighri = sighri + sig(l,m,nnn)
1398 IF(l.EQ.0.AND.m.EQ.0.AND.nn.EQ.0.AND.
n.GE.1)
THEN
1399 sigdi = sigdi + (-1)**
n*sig(l,m,nnn)
1400 ELSEIF(l.EQ.0.AND.m.EQ.0.AND.
n.EQ.0.AND.nn.GE.1)
THEN
1401 sigddi= sigddi + (-1)**nn*sig(l,m,nnn)
1407 siglmd=silmsd+silmdd
1408 sithmd=sighmd+sihmdd
1409 sigd = siglmd + sithmd
1410 slhmdd =
sqrt(abs(silmdd*sihmdd))
1411 sigdd= silmdd + sihmdd + slhmdd
1417 IF(lentry.EQ.1.AND.ioutpo.LE.1)
RETURN
1420 WRITE(6,*)
' --- properties of events ---'
1422 WRITE(6,*)
' Energy=',ecm
1424 WRITE(6,*)
' max.contributing soft/hard/diffr./doubl.diffr. cuts'
1425 WRITE(6,*)
' LMAXI= MMAXI= NMAXI= NNMAXI='
1426 WRITE(6,
'(15X,4I9)') lmaxi,mmaxi,nmaxi,nnmaxi
1427 WRITE(6,*)
' methode used: '
1428 WRITE(6,*)
' ISIG= ICON= IPIM= '
1429 WRITE(6,
'(15X,3I9)') isig,icon,ipim
1431 WRITE(6,*)
' --- bare cross section and eikonal constants ---'
1435 WRITE(6,*)
' ALFA =',alfa,
' ALFAP =',alfap,
' A =',
a
1436 WRITE(6,*)
' C =',c,
' AK =',ak
1437 WRITE(6,*)
' ALALAM =',alalam
1439 WRITE(6,*)
' SIGSOF=',sigsof,
' BS=',bs,
' ZSOF=',zsof
1440 WRITE(6,*)
' SIGHAR=',sighar,
' BH=',bh,
' ZHAR=',zhar
1441 WRITE(6,*)
' SIGTRP=',sigtrp,
' BT=',bt,
' ZTRP=',ztrp
1442 WRITE(6,*)
' SIGLOO=',sigloo,
' BT=',bt,
' ZLOO=',zloo
1444 WRITE(6,*)
' --- observable cross sections ---'
1446 WRITE(6,*)
' TOTAL X-SECTION = ',sigtot
1447 WRITE(6,*)
' ELASTIC X-SECTION = ',sigele
1448 WRITE(6,*)
' INELASTIC X-SECTION-LMD = ',sigine
1449 WRITE(6,*)
' INELASTIC X-SECTION = ',sigin
1450 WRITE(6,*)
' HARD INEL. X-SECTION = ',sighin
1452 WRITE(6,*)
' LOW MASS SING./DOUB.DIFFR.X-SECTION= ',silmsd,silmdd
1453 WRITE(6,*)
' => LOW MASS TOTAL DIFFRACTIV.X-SECTION= ',siglmd
1454 WRITE(6,*)
' HIGH MASS SING./DOUB.DIFFR.X-SECTION= ',sigdi,sigddi
1455 WRITE(6,*)
' => HIGH MASS TOTAL DIFFRACTIV.X-SECTION= ',sithmd
1456 WRITE(6,*)
' ESTIMAT.MIXED (LM+HM) DOUBL.DIFFRAC.X.SEC.= ',slhmdd
1458 WRITE(6,*)
' DIFFRACTIVE X-SECTION = ',sigd
1459 WRITE(6,*)
' DOUBLY DIFFRACTIVE X-SECT. =',sigdd
1462 IF(ioutpo.GE.0)
THEN
1463 WRITE(6,*)
' --- observ. x-sections, altern. calculated ---'
1464 WRITE(6,*)
' ELASTIC X-SECTION = ',sigel
1465 WRITE(6,*)
' INELASTIC X-SECTION-LMD = ',siginl
1466 WRITE(6,*)
' HARD INEL. X-SECTION= ',sighri
1467 WRITE(6,*)
' HIGH MASS SING./DOUB.DIFFR.X-SECT.=',sighmd,sihmdd
1468 WRITE(6,*)
' X-SECTION FOR (L,M,N,NN)= 1000 0100 0010 0001'
1469 WRITE(6,*)
' ',sig(1,0,0),sig(0,1,0)
1470 * ,sig(0,0,1),sig(0,0,2)
1474 IF(ioutpo.GE.2)
THEN
1477 IF( nmaxi.LT.2)nnmaxp=1
1481 48
WRITE(6,101)(sig(l,m,
n),m=0,7)
1484 50
WRITE(6,101)(sig(l,m,
n),m=8,15)
1487 &
' # CUT-POMERON SSOFT X-SECT. SHARD X-SECT.'
1489 58
WRITE (6,103)l,ssoft(l),shard(l)
1507 cmbin(i,j)=fak(i)/(fak(j)*fak(i-j))
1513 IF(icon.EQ.44.OR.icon.EQ.46.OR.icon.EQ.48.
1514 * or.icon.EQ.54)
THEN
1517 plmntm=sig(l,m,0)/(sigsum+tin)
1518 plmn(l,m,0) = plmntm + plmn(l,m,0)
1521 plmntm=sig(l,m,1)/(sigsum+tin)
1523 IF(l+2.LE.lmaxi)
THEN
1524 plmn(l+2,m,0) = (-2.)* plmntm + plmn(l+2,m,0)
1525 plmn(l+1,m,0) = 4. * plmntm + plmn(l+1,m,0)
1527 plmn(lmaxi,m,0) = (-2.)* plmntm + plmn(lmaxi,m,0)
1528 plmn(lmaxi,m,0) = 4. * plmntm + plmn(lmaxi,m,0)
1530 IF(l.EQ.0 .AND. m.EQ.0)
THEN
1531 plmn(l ,m,1) = (-1.)* plmntm + plmn(l ,m,1)
1533 plmn(l ,m,0) = (-1.)* plmntm + plmn(l ,m,0)
1536 plmntm=sig(l,m,2)/(sigsum+tin)
1538 IF(l+2.LE.lmaxi)
THEN
1539 plmn(l+2,m,0) = (-2.)* plmntm + plmn(l+2,m,0)
1540 plmn(l+1,m,0) = 4. * plmntm + plmn(l+1,m,0)
1542 plmn(lmaxi,m,0) = (-2.)* plmntm + plmn(lmaxi,m,0)
1543 plmn(lmaxi,m,0) = 4. * plmntm + plmn(lmaxi,m,0)
1545 IF(l.EQ.0 .AND. m.EQ.0)
THEN
1546 plmn(l ,m,2) = (-1.)* plmntm + plmn(l ,m,2)
1548 plmn(l ,m,0) = (-1.)* plmntm + plmn(l ,m,0)
1554 IF(
nmax.LE.2 .AND.
n.EQ.1 .AND. nn.EQ.1) go to 51
1558 plmntm=sig(l,m,nnn)/(sigsum+tin)
1563 DO 511 n1cut=0,
n-n0cut
1567 cmb1=cmbin(
n-n2cut,n1cut)
1571 DO 511 nn1cut=0,nn-nn0cut
1572 nn2cut=nn-nn0cut-nn1cut
1574 cmbn0=cmbin(nn,nn2cut)
1575 cmbn1=cmbin(nn-nn2cut,nn1cut)
1586 l2str=l2str + n1cut + nn1cut + n2cut + nn2cut
1589 nl2str= n2cut + nn2cut
1590 ELSEIF(
nmax.GE.3)
THEN
1592 l2str=l2str+n2cut+nn2cut
1594 IF((icon.EQ.26.OR.icon.EQ.36.OR.icon.EQ.46.OR.icon.EQ.56)
1595 & .AND. (l2str.GE.1.OR.m2str.GE.1))
THEN
1596 l2str=l2str + nl2str
1603 IF(l2str.GT.lmaxi) l2str=lmaxi
1604 IF(m2str.GT.lmaxi) m2str=lmaxi
1605 nnnstr =n2str +(nmaxi+1)*nn2str
1606 * +(nnmaxi+1)*(nmaxi+1)*nl2str
1607 IF(nnnstr.GT.mxpa13) nnnstr=mxpa13
1610 plmn(l2str,m2str,nnnstr) = plmntm
1611 * *cmb0*cmb1 * (-2)**n2cut * (4)**n1cut * (-1)**n0cut
1612 * *cmbn0*cmbn1*(-2)**nn2cut* (4)**nn1cut* (-1)**nn0cut
1613 & + plmn(l2str,m2str,nnnstr)
1620 IF(abs(tmmp-1.d0).GT..03d0)
THEN
1622 &
' NORMALISATION ERROR SUM PLM before LMD reatribution=',tmmp
1629 plmfac= (sigsum+tin) / (sigsum+tin +siglmd)
1630 plmn(0,0,1)= plmn(0,0,1) +
1631 & ( silmsd - slhmdd ) / (sigsum+tin)
1632 plmn(0,0,2)= plmn(0,0,2) +
1633 & ( silmdd + slhmdd ) / (sigsum+tin)
1651 IF(
nmax.LE.2 .AND.
n+nn+nl.GE.2) go to 6
1652 nnn =
n +(nmaxi+1)*nn +(nnmaxi+1)*(nmaxi+1)* nl
1655 IF(nl.EQ.0)tmmp1 = tmmp1 + sig(l,m,nnn)
1656 tmmp = tmmp + sig(l,m,nnn)
1657 plmn(l,m,nnn)=plmn(l,m,nnn) * plmfac
1658 tmp = tmp + plmn(l,m,nnn)
1660 IF(plmn(l,m,nnn).LT.-.000005d0)
1661 &
WRITE(6,*)
' 0>PLMN',plmn(l,m,nnn),l,m,
n,nn,nl
1662 avsofn=avsofn+plmn(l,m,nnn)*l
1663 avharn=avharn+plmn(l,m,nnn)*m
1664 avdifn=avdifn+plmn(l,m,nnn)*
n
1665 avddfn=avddfn+plmn(l,m,nnn)*nn
1666 avdlfn=avdlfn+plmn(l,m,nnn)*nl
1667 IF (m.EQ.0)psoft=psoft+plmn(l,m,nnn)
1670 IF(abs(tmp-1.d0).GT..01d0)
THEN
1672 &
' NORMALISATION ERROR SUM PLM before M reatribution=',tmp
1676 IF(abs(tmmp-1.d0).GT..01d0 .OR.abs(tmmp1-1.d0).GT..01d0)
THEN
1678 &
' NORMALISATION ERROR TMMP,TMMP1=',tmmp,tmmp1
1688 IF(
nmax.LE.2 .AND.
n+nn+nl.GE.2) go to 61
1689 nnn =
n +(nmaxi+1)*nn +(nnmaxi+1)*(nmaxi+1)* nl
1696 IF (l.EQ.0.AND.m.GE.1)
THEN
1697 plmn(1,m,nnn)=plmn(1,m,nnn)+plmn(0,m,nnn)
1701 temp = temp + plmn(l,m,nnn)
1702 plmncu(l,m,nnn)=temp
1705 IF(ioutpo.GE.3)
WRITE (6,*)
' M,(L,PLMN(L,M,N),L=0,LMAX)'
1706 IF(ioutpo.GE.3)
WRITE (6,106) m,(l,plmn(l,m,
n),l=0,lmaxi)
1707 IF(ioutpo.GE.2)
WRITE (6,*)
' M,(L,PLMNCU(L,M,N),L=0,LMAX/2)'
1708 IF(ioutpo.GE.2)
WRITE (6,106) m,(l,plmncu(l,m,
n),l=0,lmaxi/2)
1709 106
FORMAT (i3,9(i3,e11.2))
1714 IF(abs(temp-1.d0).GT..01d0)
THEN
1715 WRITE(6,*)
' NORMALISATION ERROR SUM PLM=',temp
1716 plmfac=1./(temp+tin)
1720 IF(ioutpo.GE.1)
WRITE (6,*)
1721 &
'(((L,M,N,PLMN(L,M,N),N=0,2),M=0,5),L=0,7)'
1722 IF(ioutpo.GE.1)
WRITE (6,1106)
1723 & (((l,m,
n,plmn(l,m,
n),
n=0,2),m=0,5),l=0,7)
1724 IF(ioutpo.GE.1)
WRITE (6,*)
1725 &
'(((L,M,N,SIG(L,M,N),N=0,2),M=0,5),L=0,7)'
1726 IF(ioutpo.GE.1)
WRITE (6,1106)
1727 & (((l,m,
n,sig(l,m,
n),
n=0,2),m=0,5),l=0,7)
1728 1106
FORMAT (1x,3(i5,i5,i5,g12.5))
1731 alfah=sighin/(sigine+0.00001)
1733 WRITE(6,116)avsofn,avharn,avdifn,avddfn,avdlfn,
1734 & phard,psoft,alfah,betah
1735 116
FORMAT(/
'--- various averages:'/
1736 & /
' AVSOFN= AVHARN= AVDIFN= AVDDFN= AVDLFN='
1738 & /
' PHARD= PSOFT= ALFAH= BETAH= '
1740 IF(ioutpo.GE.1)
WRITE(6,*)
'SIGSUM=SIGINL-LMD',sigsum
1742 IF(ioutpo.GE.1)
WRITE(6,610) sigtot,sigine,sigd,sigdd,sighin
1743 610
FORMAT (
' SIGTOT,SIGINE,SIGD,SIGDD,SIGHIN= '/
' ',5e18.6)
1745 101
FORMAT(
' ',10e10.3)
1747 103
FORMAT(
' ',5x,i4,5x,2e15.3)
1756 SUBROUTINE samplx(L2STR,M2STR,N2STR,NN2STR,NL2STR)
1765 IMPLICIT DOUBLE PRECISION(
a-h,o-
z)
1767 COMMON /nncms/ gamcm,bgcm,umo,pcm,eproj,pproj
1769 COMMON /pomene/poen(28),poen1(28),poen2(28),nestep
1770 parameter(mxpu50=100,mxpu51=mxpu50+1)
1771 parameter(mxpa25=30,mxpa26=mxpa25+1,mxpa13=13)
1773 parameter(mxpa50=250,mxpa51=mxpa50+1)
1777 COMMON /outlev/ioutpo,ioutpa,iouxev,ioucol
1778 COMMON /pomtyp/ipim,icon,isig,lmax,mmax,
nmax,difel,difnu
1780 COMMON /polmn/plmn(0:mxpa25,0:mxpa50,0:mxpa13),
1781 * plmncu(0:mxpa25,0:mxpa50,0:mxpa13)
1783 COMMON /polmn1/ plmnee(0:mxpa25,0:mxpu50,0:mxpa13,28)
1784 COMMON /polmn0/pdifr,phard,psoft,alfah,betah,
1785 * sigtot,sigqel,sigel,sigine,sighin,sigd,sigdd
1787 parameter(pi=3.141592654d0)
1792 IF(umo.GE.poen1(ii).AND.umo.LT.poen2(ii))
THEN
1806 ELSEIF(ipim.EQ.2)
THEN
1809 nnmaxi=(13-nmaxi)/(1+nmaxi)
1812 ELSEIF(
nmax.EQ.2)
THEN
1816 ELSEIF(
nmax.EQ.1)
THEN
1826 IF (x.LE.plmncu(0,0,0) .AND. nprint.LT.100)
THEN
1827 WRITE(6,*)
' No generator of elastic events '
1828 WRITE(6,*)
' PLMNCU (0,0,0) =!= 0 = ',plmncu(0,0,0)
1836 nnn =
n +(nmaxi+1)*nn +(nnmaxi+1)*(nmaxi+1)* nl
1841 IF (x.LE.plmnee(l,m,nnn,ipoen))
THEN
1855 IF(nprint.LT.100)
WRITE(6,*)
' RAR.IN SAMPLM,PLMNCU,RND=',
1856 & plmncu(lmax, mmax,nnn),x,nprint
1857 IF( plmncu(lmax,mmax,nnn) .GT. 0.1d0 )
RETURN
1858 IF( plmncu(lmax,0,0) .GT. 0.1d0 )
RETURN
1859 WRITE(6,*)
' RAR.IN SAMPLM- PROBLEM SEEMS BAD, DECIDE TO STOP'
1875 IMPLICIT DOUBLE PRECISION(
a-h,o-
z)
1877 COMMON /nncms/ gamcm,bgcm,umo,pcm,eproj,pproj
1879 COMMON /pomene/poen(28),poen1(28),poen2(28),nestep
1880 parameter(mxpu50=100,mxpu51=mxpu50+1)
1882 COMMON /outlev/ioutpo,ioutpa,iouxev,ioucol
1883 COMMON /pomtyp/ipim,icon,isig,lmax,mmax,
nmax,difel,difnu
1885 parameter(mxpa25=30,mxpa26=mxpa25+1,mxpa13=13)
1887 parameter(mxpa50=250,mxpa51=mxpa50+1)
1890 COMMON /polmn/plmn(0:mxpa25,0:mxpa50,0:mxpa13),
1891 * plmncu(0:mxpa25,0:mxpa50,0:mxpa13)
1893 COMMON /polmn1/ plmnee(0:mxpa25,0:mxpu50,0:mxpa13,28)
1894 COMMON /polmn0/pdifr,phard,psoft,alfah,betah,
1895 * sigtot,sigqel,sigel,sigine,sighin,sigd,sigdd
1897 parameter(pi=3.141592654d0)
1900 IF(umo.GE.poen1(ii).AND.umo.LT.poen2(ii))
THEN
1910 IF (x.LE.plmncu(0,0,0))
THEN
1911 WRITE(6,*)
' No generator of elastic events '
1912 WRITE(6,*)
' PLMNCU (0,0,0) =!= 0 = ',plmncu(0,0,0)
1922 IF (x.LE.plmnee(l,m,
n,ipoen))
THEN
1933 WRITE(6,*)
' RAR.IN SAMPLM,PLMNCU,RND=',plmncu(lmax,mmax,
nmax),x
1934 IF( plmncu(lmax,mmax,
nmax) .GT. 0.1d0 )
RETURN
1935 IF( plmncu(lmax,0,0) .GT. 0.1d0 )
RETURN
1936 WRITE(6,*)
' RAR.IN SAMPLM- PROBLEM SEEMS BAD, DECIDE TO STOP'
2004 IMPLICIT DOUBLE PRECISION(
a-h,o-
z)
2008 parameter(mxpa25=30,mxpa26=mxpa25+1,mxpa13=13)
2010 parameter(mxpa50=250,mxpa51=mxpa50+1)
2013 COMMON /polmn/plmn(0:mxpa25,0:mxpa50,0:mxpa13),
2014 * plmncu(0:mxpa25,0:mxpa50,0:mxpa13)
2015 COMMON /polmn0/pdifr,phard,psoft,alfah,betah,
2016 * sigtot,sigqel,sigel,sigine,sighin,sigd,sigdd
2019 COMMON /histoo/as(50,9),aecm(50,9),asig(50,9),alos(50,9),
2020 * aloecm(50,9),ndislm(0:mxpa25,0:mxpa50,0:mxpa13)
2022 COMMON /outlev/ioutpo,ioutpa,iouxev,ioucol
2027 common/pompar/alfa,alfap,
a,c,ak
2032 COMMON /sigma/sigsof,bs,zsof,sighar,bh,zhar,sigtrp,bt,ztrp,
2037 COMMON /pomtyp/ipim,icon,isig,lmax,mmax,
nmax,difel,difnu
2038 COMMON /alala/alalam
2041 COMMON /collpo/
s,ptthr,ptthr2
2043 COMMON /collis/ss,ijproj,ijtar,pttpo,pttpo2,iophrd,ijprlu,ijtalu
2047 parameter(pi=3.141592654d0)
2063 *
' ------ testing the energy dependence of x-sections ----------'
2065 IF(ioutpo.GT.-1)
WRITE(6,*)
2066 *
' (as function of ALAM i.e.a low mass diffr.parameter)'
2067 WRITE(6,*)
' -----------------------------------------------'
2071 IF(ioutpo.GT.-1 .OR. iijj.EQ.6)
THEN
2075 IF(ioutpo.GT.-1)
WRITE(6,1008)alalam
2076 1008
FORMAT (
' ALAM= ',f10.3)
2098 nnmaxi=(13-nmaxi)/(1+nmaxi)
2101 ELSEIF(
nmax.EQ.2)
THEN
2105 ELSEIF(
nmax.EQ.1)
THEN
2112 IF(ipim.LT.1.AND.ipim.GT.9)
THEN
2113 WRITE(6,*)
'RETURN caused by IPIM=',ipim
2122 * (
'--- sample distribution for L soft and M hard inelastic'
2123 * ,
' pomerons (string pairs)--- '
2124 * / 20x,
'at ECM = ',f10.2,
' S = ',f12.1)
2132 IF(icon.EQ.12)go to 100
2135 CALL
samplx(l2str,m2str,n2str,nn2str,nl2str)
2136 nnnstr =n2str +(nmaxi+1)*nn2str
2137 * +(nnmaxi+1)*(nmaxi+1)*nl2str
2138 ndislm(l2str,m2str,nnnstr)=ndislm(l2str,m2str,nnnstr)+1
2140 CALL
samplm(l2str,m2str,n2str)
2141 ndislm(l2str,m2str,n2str)=ndislm(l2str,m2str,n2str)+1
2146 *
' with no diffractive contribution'
2149 *
' ....... vertical: NSTR, horizontal MSTR .........'
2150 DO 3344 l=0,min(20,lmaxi)
2151 3344
WRITE(6,34)l,(ndislm(l,m,0),m=0,20)
2156 WRITE(6,*)
' WITH NSTR=',
n
2157 DO 334 l=0,min(20,lmaxi)
2158 WRITE(6,34)l,(ndislm(l,m,
n),m=0,20)
2162 jmpa50 =
int(mxpa50/25)
2164 WRITE(6,*)
'WIDE PLOT 0<L<',mxpa25,
' 0<M<'
2165 & ,mxpa50,
' IN STEPS OF ',jmpa50
2168 WRITE(6,35)l,(ndislm(l,m,
n),m=0,mxpa50,jmpa50)
2173 34
FORMAT (i5,
':',21i4)
2196 IMPLICIT DOUBLE PRECISION(
a-h,o-
z)
2200 COMMON /outlev/ioutpo,ioutpa,iouxev,ioucol
2202 parameter(mxpa25=30,mxpa26=mxpa25+1,mxpa13=13)
2203 parameter(
zero=0.d0,
one=1.d0)
2205 parameter(mxpa50=250,mxpa51=mxpa50+1)
2208 COMMON /polmn/plmn(0:mxpa25,0:mxpa50,0:mxpa13),
2209 * plmncu(0:mxpa25,0:mxpa50,0:mxpa13)
2210 COMMON /polmn0/pdifr,phard,psoft,alfah,betah,
2211 * sigtot,sigqel,sigel,sigine,sighin,sigd,sigdd
2214 COMMON /pomtyp/ipim,icon,isig,lmax,mmax,
nmax,difel,difnu
2215 common/pompar/alfa,alfap,
a,c,ak
2216 COMMON /sigma/sigsof,bs,zsof,sighar,bh,zhar,sigtrp,bt,ztrp,
2219 COMMON /topdr/itopd,idumtp
2222 COMMON /histoo/as(50,9),aecm(50,9),asig(50,9),alos(50,9),
2223 * aloecm(50,9),ndislm(0:mxpa25,0:mxpa50,0:mxpa13)
2225 parameter(pi=3.141592654d0)
2232 IF(ioutpo.GT.-1)istep=7
2243 alos(i,iii)=log10(
s)
2244 aloecm(i,iii)=log10(ecm)
2252 IF(i.EQ.1 .AND. ioutpo.GE.0 )
WRITE(6,*)
2253 &
' s-dep. by integr.with Y,PHI,LMD'
2256 IF(i.EQ.1 .AND. ioutpo.GE.0 )
WRITE(6,*)
2257 &
' s-dep. by integr.with Y,PHI,LMD (DEFAULT)'
2269 asig(i,7)=sigtot-sigine
2270 asig(i,8)=sigine-sighin
2272 WRITE (6,1007)ecm,sigtot,sigine,sigel,sigd
2273 1007
FORMAT (
' ECM,SIGTOT,SIGINE,SIGEL,SIGD',f10.1,4e14.3)
2281 991
FORMAT (//
' shown as line printer plott'/
' with'/
2283 1
' (*) SIGTOT total x-section',
2284 2
' (2) SIGINE inelastic x-section'/
2285 3
' (3) SIGHIN hard inelastic cross section, one or more jets',
2286 4
' (4) SIGSOF input soft x-section'/
2287 5
' (5) SIGHAR input hard x-sections',
2288 6
' (6) SIGTRP input diffractive x-section (triple pomeron)'/
2289 7
' (7) SIGTOT-SIGINE elastic x-section',
2290 8
' (8) SIGINE-SIGHIN non-hard inelastic x-section, (no jets)'/
2291 9
' (9) SIGD diffractive xross section '/
2292 *
' are plotted against LOG(10)of(CMENERGY)' //)
2298 IF (itopd.EQ.1)
THEN
2300 95
FORMAT(
' NEW FRAME'/
' SET FONT DUPLEX'/
' SET SCALE X LOG'/
2301 *
' SET LIMITS X FROM 1.0 TO 1E5 Y FROM 0. TO 200'/
2302 *
' TITLE TOP < TOTAL,INEL. AND HARD (MINIJET) CROSS SECT.<'/
2303 *
' TITLE BOTTOM <C.M.ENERGY [GEV]<'/
2304 *
' TITLE < DUAL UNITARIZATION OF SOFT AND HARD CROSS SECTIONS<'/
2305 *
' TITLE LEFT LINES=-1 <CROSS SECTION [MB]<'/
2306 *
' TITLE 3 8.5 < SOLID = TOTAL X.S. <'/
2307 *
' TITLE < DASHED= INELASTIC X.S. <'/
2308 *
' TITLE < DOTTED= HARD X.S.<'/
2309 *
' TITLE < DOT-DASH= HARD INPUT X.S. <'/
2310 *
' TITLE < DOT-DASH= ELASTIC X.S. <')
2313 IF (iuu.EQ.4)go to 94
2314 IF (iuu.EQ.6)go to 94
2315 IF (iuu.EQ.1)
WRITE(7,97)
2316 97
FORMAT (
' SET TEXTURE SOLID')
2317 IF (iuu.EQ.2)
WRITE(7,98)
2318 98
FORMAT (
' SET TEXTURE DASHES')
2319 IF (iuu.EQ.3)
WRITE(7,99)
2320 99
FORMAT (
' SET TEXTURE DOTS')
2321 IF (iuu.EQ.5)
WRITE(7,197)
2322 197
FORMAT (
' SET TEXTURE DOTDASH')
2324 WRITE(7,92)aecm(iu,iuu),asig(iu,iuu)
subroutine gset(AX, BX, NX, Z, W)
typedef int(XMLCALL *XML_NotStandaloneHandler)(void *userData)
BasicVector3D< T > unit() const
subroutine samplm(L2STR, M2STR, N2STR)
subroutine samplx(L2STR, M2STR, N2STR, NN2STR, NL2STR)
subroutine plot(X, Y, N, M, MM, XO, DX, YO, DY)
double precision function energy(A, Z)
double precision function rndm(RDUMMY)
subroutine title(NA, NB, NCA, NCB)
static c2_log_p< float_type > & log()
make a *new object
static c2_sqrt_p< float_type > & sqrt()
make a *new object
static c2_exp_p< float_type > & exp()
make a *new object