]> git.uio.no Git - u/mrichter/AliRoot.git/blobdiff - DPMJET/dpmjet3.0-5.f
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Extra header added to the list
[u/mrichter/AliRoot.git] / DPMJET / dpmjet3.0-5.f
diff --git a/DPMJET/dpmjet3.0-5.f b/DPMJET/dpmjet3.0-5.f
index 3c0b6a9b5289c138aba6d1db43830735d8a2b2b6..cbd43185a9fddc10eb105aecd13539cfd0f4dc65 100644 (file)
--- a/DPMJET/dpmjet3.0-5.f
+++ b/DPMJET/dpmjet3.0-5.f
@@ -2099,7 +2099,7 @@ C     IF (IDP.EQ.27) IDP = 6
       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
@@ -2203,6 +2203,9 @@ C     ENDIF
       LOGICAL LPROD
       CHARACTER*8 CGLB
       COMMON /DTGLGP/ JSTATB,JBINSB,CGLB,IOGLB,LPROD
+      COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
+     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+     &                NCP,NCT
 
       DIMENSION WHAT(6)
 
@@ -2302,6 +2305,7 @@ C        IF (LFZC) CALL DT_DECAY1
 
 C     IF (NEVHKK.EQ.5) CALL DT_EVTOUT(4)
       RETURN
+
  9999 CONTINUE
       IREJ = 1
 
@@ -3359,8 +3363,11 @@ C     STOP
       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)
@@ -3495,7 +3502,8 @@ C #include "dtu_dtevtp.inc"
       COMMON /DTLTSU/ BGX,BGY,BGZ,GAM
 * Glauber formalism: collision properties
       COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
-     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC
+     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+     &                NCP,NCT
 * flags for diffractive interactions (DTUNUC 1.x)
       COMMON /DTFLG3/ ISINGD,IDOUBD,IFLAGD,IDIFF
 * statistics: double-Pomeron exchange
@@ -5192,9 +5200,7 @@ C           ENDIF
       IREJ   = 0
       ICREQU = ICREQU+1
       NC     = 0
-      NCP    = 0
-      NCT    = 0
-
+ 
     1 CONTINUE
       ICSAMP = ICSAMP+1
       NC     = NC+1
@@ -5233,15 +5239,19 @@ C           ENDIF
          ITOLD  = IT
          JJPOLD = JJPROJ
          EPROLD = EPROJ
+         NCP    = 0
+         NCT    = 0
+
         DO 8 I=1, IP
            NCP = NCP+JSSH(I)
 *          WRITE(6,*)' PROJ.NUCL. ',I,' NCOLL = ',NCP 
     8 CONTINUE
+      write(6,*) "why this (1)", NCP, NCT
         DO 9 I=1, IT
-           NCT = NCT+JTSH(I)
-*          WRITE(6,*)' TAR.NUCL. ',I,' NCOLL = ',NCT 
+           NCT = NCT +JTSH(I)
+*          WRITE(6,*)' TAR.NUCL. ',I,' NCOLL = ',NCT
     9 CONTINUE
-      ENDIF
+       ENDIF
 
 * force diffractive particle production in h-K interactions
       IF (((ABS(ISINGD).GT.1).OR.(ABS(IDOUBD).GT.1)).AND.
@@ -5497,7 +5507,8 @@ C           ENDIF
      &                IICH(210),IIBAR(210),K1(210),K2(210)
 * Glauber formalism: collision properties
       COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
-     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC
+     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+     &                NCP,NCT
 * flavors of partons (DTUNUC 1.x)
       COMMON /DTDPMF/ IPVQ(MAXVQU),IPPV1(MAXVQU),IPPV2(MAXVQU),
      &                ITVQ(MAXVQU),ITTV1(MAXVQU),ITTV2(MAXVQU),
@@ -5736,7 +5747,8 @@ C        ENDIF
      &                IICH(210),IIBAR(210),K1(210),K2(210)
 * Glauber formalism: collision properties
       COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
-     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC
+     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+     &                NCP,NCT
 **temporary
 * statistics: Glauber-formalism
       COMMON /DTSTA3/ ICWP,ICWT,NCSY,ICWPG,ICWTG,ICIG,IPGLB,ITGLB,NGLB
@@ -8715,8 +8727,8 @@ C     PA2(3) = SIGN(SQRT(PZ2NSQ),PA2(3))
      &                IREXCI(3),IRDIFF(2),IRINC
 * Glauber formalism: collision properties
       COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
-     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC
-
+     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+     &                NCP,NCT
       DIMENSION R(3),PIN(4),POUT(4),DEV(4)
 
       DO 1 K=1,4
@@ -8823,7 +8835,8 @@ C              PHKK(K,I) = PHKK(K,I)-DEV(K)/DBLE(NVAL)
      &                IREXCI(3),IRDIFF(2),IRINC
 * Glauber formalism: collision properties
       COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
-     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC
+     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+     &                NCP,NCT
 * various options for treatment of partons (DTUNUC 1.x)
 * (chain recombination, Cronin,..)
       LOGICAL LCO2CR,LINTPT
@@ -10706,7 +10719,8 @@ C                    ENDIF
       COMMON /DTGPRO/ VIRT,PGAMM(4),PLEPT0(4),PLEPT1(4),PNUCL(4),IDIREC
 * Glauber formalism: collision properties
       COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
-     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC
+     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+     &                NCP,NCT
 * Glauber formalism: flags and parameters for statistics
       LOGICAL LPROD
       CHARACTER*8 CGLB
@@ -16056,7 +16070,8 @@ C           QARJ(I) = PARJ(I)
       COMMON /DTPRTA/ IT,ITZ,IP,IPZ,IJPROJ,IBPROJ,IJTARG,IBTARG
 * Glauber formalism: collision properties
       COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
-     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC
+     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+     &                NCP,NCT
 * flags for input different options
       LOGICAL LEMCCK,LHADRO,LSEADI,LEVAPO
       COMMON /DTFLG1/ IFRAG(2),IRESCO,IMSHL,IRESRJ,IOULEV(6),
@@ -16244,7 +16259,8 @@ C9990 CONTINUE
      &                IICH(210),IIBAR(210),K1(210),K2(210)
 * Glauber formalism: collision properties
       COMMON /DTGLCP/ RPROJ,RTARG,BIMPAC,
-     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC
+     &                NWTSAM,NWASAM,NWBSAM,NWTACC,NWAACC,NWBACC,
+     &                NCP,NCT
 * nuclear potential
       LOGICAL LFERMI
       COMMON /DTNPOT/ PFERMP(2),PFERMN(2),FERMOD,
@@ -17925,37 +17941,38 @@ C     EPOT(2,8) = PFERMN(2)**2/(2.0D0*AAM(8)) + EBINDN(2)
 
 * 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
@@ -26780,6 +26797,7 @@ C     DO 1 I=1,NEND
       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