ENDIF
* disallow Cronin's multiple scattering for nucleus-nucleus interactions
- IF ((IP.GT.1).AND.(MKCRON.GT.0)) THEN
+ IF ((IP.GT.1).AND. (IT.GT.1) .AND. (MKCRON.GT.0)) THEN
WRITE(LOUT,1005)
1005 FORMAT(/,1X,'INIT: multiple scattering disallowed',/)
MKCRON = 0
LOGICAL LFZC
* event history
+
+ PARAMETER (NMXHEP=4000)
+ COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
+ & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),
+ & VHEP(4,NMXHEP), NSD1, NSD2, NDD
+
PARAMETER (NMXHKK=200000)
COMMON /DTEVT1/ NHKK,NEVHKK,ISTHKK(NMXHKK),IDHKK(NMXHKK),
& JMOHKK(2,NMXHKK),JDAHKK(2,NMXHKK),
IREJ = 0
ILOOP = 0
+ NSD1 = 0
+ NSD2 = 0
+ NDD = 0
100 CONTINUE
IF (ILOOP.EQ.4) THEN
WRITE(LOUT,1000) NEVHKK
IF (IPI0.EQ.1) CALL DT_DECPI0
C IF (NEVHKK.EQ.5) CALL DT_EVTOUT(4)
-
RETURN
9999 CONTINUE
IREJ = 1
+
RETURN
END
& NCOMPO,IEMUL
* event flag
COMMON /DTEVNO/ NEVENT,ICASCA
-
CHARACTER*8 DATE,HHMMSS
DIMENSION IDMNYR(3)
-
+ NSD1 = 0
+ NSD2 = 0
+ NDD = 0
KKMAT = 1
NMSG = MAX(NEVTS/100,1)
CALL DT_KKINC(NPMASS,NPCHAR,NTMASS,NTCHAR,IDP,EPN,KKMAT,IREJ)
CALL PHO_PHIST(2000,DUM)
+
+ write(6,*) "Diffractive collisions", NSD1, NSD2, NDD
2 CONTINUE
* print run-statistics and histograms to output-unit 6
CALL PHO_PHIST(3000,DUM)
CALL DT_STATIS(2)
-
RETURN
END
IF (LBEAM) THEN
IF ( (NPOINT(4).EQ.0).OR.(NHKK.LT.NPOINT(4)) ) RETURN
DO 20 I=NPOINT(4),NHKK
- IF ((ABS(ISTHKK(I)).EQ.1).OR.(ISTHKK(I).EQ.1000).OR.
- & (ISTHKK(I).EQ.1001)) THEN
+ IF ((ABS(ISTHKK(I)).EQ.1) .OR.
+ & (ABS(ISTHKK(I)).EQ.2) .OR.
+ & (ISTHKK(I).EQ.1000) .OR.
+ & (ISTHKK(I).EQ.1001)) THEN
+
CALL DT_MYTRAN(1,PHKK(1,I),PHKK(2,I),PHKK(3,I),
& COD,SID,COF,SIF,PXCMS,PYCMS,PZCMS)
PECMS = PHKK(4,I)
DOUBLE PRECISION PHEP,VHEP
COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
& JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),
- & VHEP(4,NMXHEP)
+ & VHEP(4,NMXHEP), NSD1, NSD2, NDD
C extension to standard particle data interface (PHOJET specific)
INTEGER IMPART,IPHIST,ICOLOR
COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP)
& INTER1(MAXINT),INTER2(MAXINT)
* Glauber formalism: collision properties
COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
- & NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC
+ & NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+ & NCP,NCT
* central particle production, impact parameter biasing
COMMON /DTIMPA/ BIMIN,BIMAX,XSFRAC,ICENTR
**temporary
IREJ = 0
ICREQU = ICREQU+1
NC = 0
+ NCP = 0
+ NCT = 0
1 CONTINUE
ICSAMP = ICSAMP+1
ITOLD = IT
JJPOLD = JJPROJ
EPROLD = EPROJ
+ DO 8 I=1, IP
+ NCP = NCP+JSSH(I)
+* WRITE(6,*)' PROJ.NUCL. ',I,' NCOLL = ',NCP
+ 8 CONTINUE
+ DO 9 I=1, IT
+ NCT = NCT+JTSH(I)
+* WRITE(6,*)' TAR.NUCL. ',I,' NCOLL = ',NCT
+ 9 CONTINUE
ENDIF
* force diffractive particle production in h-K interactions
* correction of projectile 4-momentum for effective target pot.
* and Coulomb-energy (in case of hadron-nucleus interaction only)
- IF ((IP.EQ.1).AND.(IT.GT.1).AND.LFERMI) THEN
- EPNI = EPN
+* IF ((IP.EQ.1).AND.(IT.GT.1).AND.LFERMI) THEN
+* EPNI = EPN
* Coulomb-energy:
* positively charged hadron - check energy for Coloumb pot.
- IF (IICH(IJPROJ).EQ.1) THEN
- THRESH = ETACOU(2)+AAM(IJPROJ)
- IF (EPNI.LE.THRESH) THEN
- WRITE(LOUT,1000)
- 1000 FORMAT(/,1X,'KKINC: WARNING! projectile energy',
- & ' below Coulomb threshold - event rejected',/)
- ISTHKK(1) = 1
- RETURN
- ENDIF
+* IF (IICH(IJPROJ).EQ.1) THEN
+* THRESH = ETACOU(2)+AAM(IJPROJ)
+* IF (EPNI.LE.THRESH) THEN
+* WRITE(LOUT,1000)
+* 1000 FORMAT(/,1X,'KKINC: WARNING! projectile energy',
+* & ' below Coulomb threshold - event rejected',/)
+* ISTHKK(1) = 1
+* RETURN
+* ENDIF
* negatively charged hadron - increase energy by Coulomb energy
- ELSEIF (IICH(IJPROJ).EQ.-1) THEN
- EPNI = EPNI+ETACOU(2)
- ENDIF
- IF ((IJPROJ.EQ.1).OR.(IJPROJ.EQ.8)) THEN
+* ELSEIF (IICH(IJPROJ).EQ.-1) THEN
+* EPNI = EPNI+ETACOU(2)
+* ENDIF
+* IF ((IJPROJ.EQ.1).OR.(IJPROJ.EQ.8)) THEN
* Effective target potential
*sr 6.6. binding energy only (to avoid negative exc. energies)
C EPNI = EPNI+EPOT(2,IJPROJ)
- EBIPOT = EBINDP(2)
- IF ((IJPROJ.NE.1).AND.(ABS(EPOT(2,IJPROJ)).GT.5.0D-3))
- & EBIPOT = EBINDN(2)
- EPNI = EPNI+ABS(EBIPOT)
+* EBIPOT = EBINDP(2)
+* IF ((IJPROJ.NE.1).AND.(ABS(EPOT(2,IJPROJ)).GT.5.0D-3))
+* & EBIPOT = EBINDN(2)
+* EPNI = EPNI+ABS(EBIPOT)
* re-initialization of DTLTRA
- DUM1 = ZERO
- DUM2 = ZERO
- CALL DT_LTINI(IJPROJ,IJTARG,EPNI,DUM1,DUM2,0)
- ENDIF
- ENDIF
+* DUM1 = ZERO
+* DUM2 = ZERO
+*
+* CALL DT_LTINI(IJPROJ,IJTARG,EPNI,DUM1,DUM2,0)
+* ENDIF
+* ENDIF
* projectile in n-n cms
IF ((IP.LE.1).AND.(IT.GT.1)) THEN
DO 1 I=NPOINT(4),NHKK
IF ((ABS(ISTHKK(I)).EQ.1).OR.(ISTHKK(I).EQ.1000).OR.
& (ISTHKK(I).EQ.1001)) THEN
+
CALL DT_LTNUC(PHKK(3,I),PHKK(4,I),PZ,PE,-3)
PHKK(3,I) = PZ
PHKK(4,I) = PE
WRITE(LOUT,1000)
1000 FORMAT(/,/,1X,'STATIS:',20X,'statistics of the run',/,
& 28X,'---------------------')
+ IF (ICREQU.GT.0) THEN
WRITE(LOUT,1001) ICREQU,ICSAMP,DBLE(ICSAMP)/DBLE(ICREQU)
1001 FORMAT(/,1X,'number of events requested / sampled',13X,
& I8,' / ',I8,/,1X,'number of samp. evts per requested ',
& 'event',11X,F9.1)
+ ENDIF
IF (ICDIFF(1).NE.0) THEN
WRITE(LOUT,1009) ICDIFF
1009 FORMAT(/,1X,'diffractive events: total ',I8,/,49X,
& 'low mass high mass',/,24X,'single diffraction',
& 7X,I8,4X,I8,/,24X,'double diffraction',7X,I8,4X,I8)
ENDIF
- IF (ICENTR.GT.0) THEN
+ IF (ICENTR.GT.0.AND.ICSAMP.GT.0.AND.ICCPRO.GT.0) THEN
WRITE(LOUT,1002) DBLE(ICCPRO)/DBLE(ICSAMP),
& DBLE(ICSAMP)/DBLE(ICCPRO)
1002 FORMAT(/,1X,'central production:',/,2X,'mean number',
& ' of sampled Glauber-events per event',9X,F9.1,/,
& 2X,'fraction of production cross section',21X,F10.6)
ENDIF
+ IF (ICSAMP.GT.0) THEN
WRITE(LOUT,1003) DBLE(ICDPR)/DBLE(ICSAMP),
& DBLE(ICDTA)/DBLE(ICSAMP)
1003 FORMAT(/,54X,'proj. targ.',/,1X,'average number of wounded',
& ' nucleons after x-sampling',2(4X,F6.2))
+ ENDIF
IF (MCGENE.EQ.1) THEN
+ IF (ICSAMP.GT.0) THEN
WRITE(LOUT,1004) DBLE(ICRJSS)/DBLE(ICSAMP)
1004 FORMAT(/,1X,'mean number of sea-sea chain rejections per',
& ' event',3X,F9.1)
1005 FORMAT(/,1X,'Reggeon contribution:',/,1X,'mean number ',
& 'of single chains per event',13X,F9.1)
ENDIF
+ ENDIF
+ IF (ICSAMP.GT.0.AND.ICREQU.GT.0) THEN
WRITE(LOUT,1006)
1006 FORMAT(/,1X,'chain system statistics: (per event)',/,
& 23X,'mean number of chains mean number of chains',/,
& 'Treatment of final nucleon conf.',10X,'IREXCI(1)/NEVT = '
& ,F7.2,/,43X,'IREXCI(2)/NEVT = ',F7.2,/,48X,
& 'IREXCI(3) = ',I5,/)
+ ENDIF
ELSEIF (MCGENE.EQ.2) THEN
WRITE(LOUT,1010) ELOJET
1010 FORMAT(/,/,1X,'PHOJET-treatment of chain systems above ',
1013 FORMAT(/,1X,'2. chain system statistics -',
& ' mean numbers per evt:',/,30X,'---------------------',
& /,/,16X,'s-s',7X,'d-s',7X,'s-d')
+ IF (ICSAMP.GT.0) THEN
WRITE(LOUT,1014)
& ((DBLE(ICEVTG(I,J))/DBLE(ICSAMP),I=1,3),J=0,1),
& (DBLE(ICCHAI(2,I))/(2.0D0*DBLE(ICSAMP)),I=1,3),
& ' dbl-dir ',3E10.2,/,' s-Pom. ',3E10.2,/,
& ' h-Pom. ',3E10.2,/,' s-Reg. ',3E10.2,/,
& ' enh-trg ',3E10.2,/,' enh-log ',3E10.2)
+ ENDIF
WRITE(LOUT,1015)
1015 FORMAT(/,16X,'s-v',7X,'d-v',7X,'v-s',7X,'v-d',7X,'v-v')
+ IF (ICSAMP.GT.0) THEN
WRITE(LOUT,1016)
& ((DBLE(ICEVTG(I,J))/DBLE(ICSAMP),I=4,8),J=0,1),
& (DBLE(ICCHAI(2,I))/(2.0D0*DBLE(ICSAMP)),I=4,8),
& ' dbl-dir ',5E10.2,/,' s-Pom. ',5E10.2,/,
& ' h-Pom. ',5E10.2,/,' s-Reg. ',5E10.2,/,
& ' enh-trg ',5E10.2,/,' enh-log ',5E10.2)
+ ENDIF
ENDIF
CALL DT_CHASTA(1)
DOUBLE PRECISION PHEP,VHEP
COMMON /POEVT1/ NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
& JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),
- & VHEP(4,NMXHEP)
+ & VHEP(4,NMXHEP),NSD1, NSD2, NDD
C extension to standard particle data interface (PHOJET specific)
INTEGER IMPART,IPHIST,ICOLOR
COMMON /POEVT2/ IMPART(NMXHEP),IPHIST(2,NMXHEP),ICOLOR(2,NMXHEP)
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff