]> git.uio.no Git - u/mrichter/AliRoot.git/blobdiff - DPMJET/phojet1.12-35c3.f
Double check if SM is running added. Some redundant output removed from SM
[u/mrichter/AliRoot.git] / DPMJET / phojet1.12-35c3.f
index d49487c0d4ecc76be25b699c7b109aef1b7b0ee6..8e793debb6f5c67991f5e2501701059436051443 100644 (file)
@@ -494,7 +494,7 @@ C  hard cross sections and MC selection weights
       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
       INTEGER MDCY,MDME,KFDP
       DOUBLE PRECISION  BRAT
-      COMMON/PYDAT3/MDCY(500,3),MDME(4000,2),BRAT(4000),KFDP(4000,5)
+      COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
 
       INTEGER PYCOMP
 
@@ -2496,7 +2496,7 @@ C  standard particle data interface
       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)
@@ -9962,29 +9962,29 @@ C  consistency check
         ENDIF
 
         IF((IDEB(55).GE.2).AND.(IP.EQ.1)) THEN
-          print LO,'------------------------------------------------'
-          print LO,'IP,ECM:',IP,ECM
-          print LO,'SIGTOT:',SIGTOT
-          print LO,'SIGELA:',SIGELA
-          print LO,'SIGVM :',SIGVM(0,0)
-          print LO,'SIGCDF:',SIGCDF(0)
-          print LO,'SIGDIR:',SIGDIR
-          print LO,'SIGLSD:',SIGLSD
-          print LO,'SIGHSD:',SIGHSD
-          print LO,'SIGLDD:',SIGLDD
-          print LO,'SIGHDD:',SIGHDD
-          print LO,'SIGNDF:',SIGNDF
-
-          print LO,'SIGPOM:',SIGPOM
-          print LO,'SIGREG:',SIGREG
-          print LO,'SIGHAR:',SIGHAR
-          print LO,'SIGDIR:',SIGDIR
-          print LO,'SIGTR1:',SIGTR1
-          print LO,'SIGTR2:',SIGTR2
-          print LO,'SIGLOO:',SIGLOO
-          print LO,'SIGDPO:',SIGDPO
-          print LO,'SIG1SO:',SIG1SO
-          print LO,'SIG1HA:',SIG1HA
+          WRITE(LO,*) '------------------------------------------------'
+          WRITE(LO,*) 'IP,ECM:',IP,ECM
+          WRITE(LO,*) 'SIGTOT:',SIGTOT
+          WRITE(LO,*) 'SIGELA:',SIGELA
+          WRITE(LO,*) 'SIGVM :',SIGVM(0,0)
+          WRITE(LO,*) 'SIGCDF:',SIGCDF(0)
+          WRITE(LO,*) 'SIGDIR:',SIGDIR
+          WRITE(LO,*) 'SIGLSD:',SIGLSD
+          WRITE(LO,*) 'SIGHSD:',SIGHSD
+          WRITE(LO,*) 'SIGLDD:',SIGLDD
+          WRITE(LO,*) 'SIGHDD:',SIGHDD
+          WRITE(LO,*) 'SIGNDF:',SIGNDF
+
+          WRITE(LO,*) 'SIGPOM:',SIGPOM
+          WRITE(LO,*) 'SIGREG:',SIGREG
+          WRITE(LO,*) 'SIGHAR:',SIGHAR
+          WRITE(LO,*) 'SIGDIR:',SIGDIR
+          WRITE(LO,*) 'SIGTR1:',SIGTR1
+          WRITE(LO,*) 'SIGTR2:',SIGTR2
+          WRITE(LO,*) 'SIGLOO:',SIGLOO
+          WRITE(LO,*) 'SIGDPO:',SIGDPO
+          WRITE(LO,*) 'SIG1SO:',SIG1SO
+          WRITE(LO,*) 'SIG1HA:',SIG1HA
         ENDIF
 
         SIGTAB(IP,77,IE) = PTCUT(IP)
@@ -11836,6 +11836,11 @@ C  event debugging information
      &        KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD
       COMMON /PODEBG/ IDEB(NMAXD),KSPOM,KHPOM,KSREG,KHDIR,KACCEP,KSTRG,
      &                KHTRG,KSLOO,KHLOO,KSDPO,KHDPO,KEVENT,KSOFT,KHARD
+      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
+
 C  model switches and parameters
       CHARACTER*8 MDLNA
       INTEGER ISWMDL,IPAMDL
@@ -12204,10 +12209,18 @@ C  sample strings to prepare fragmentation
           CALL PHO_PREVNT(-1)
           RETURN
         ENDIF
-        IF(IPROC.EQ.5) ID1A = ID1A+1
-        IF(IPROC.EQ.6) ID2A = ID2A+1
-        IF(IPROC.EQ.7) ID3A = ID3A+1
-
+        IF(IPROC.EQ.5) THEN 
+           ID1A = ID1A+1
+           NSD1 = NSD1 +1
+           ENDIF
+        IF(IPROC.EQ.6) THEN
+           ID2A = ID2A+1
+           NSD2 = NSD2 + 1
+        ENDIF
+        IF(IPROC.EQ.7) THEN
+           ID3A = ID3A+1
+           NDD = NDD + 1
+        ENDIF
 C-----------------------------------------------------------------------
 C  single / double direct processes
 
@@ -12260,9 +12273,18 @@ C  sample strings to prepare fragmentation
           CALL PHO_PREVNT(-1)
           RETURN
         ENDIF
-        IF(IPROC.EQ.5) ID1A = ID1A+1
-        IF(IPROC.EQ.6) ID2A = ID2A+1
-        IF(IPROC.EQ.7) ID3A = ID3A+1
+        IF(IPROC.EQ.5) THEN 
+           ID1A = ID1A+1
+           NSD1 = NSD1 +1
+        ENDIF
+        IF(IPROC.EQ.6) THEN
+           ID2A = ID2A+1
+           NSD2 = NSD2 + 1
+        ENDIF
+        IF(IPROC.EQ.7) THEN
+           ID3A = ID3A+1
+           NDD = NDD + 1
+        ENDIF
         IDIA = IDIA+MHDIR
 
 C-----------------------------------------------------------------------
@@ -17616,7 +17638,7 @@ C  use explicit PDF virtuality dependence (pre-tabulated)
                 SIGSRH(1) = HSig(10)+HSig(11)
                 SIGSRH(2) = HSig(12)+HSig(13)
                 SIGtmp = SIGTOT-SIGDIH-SIGSRH(1)-SIGSRH(2)
-                print LO,' PHO_CSINT: invalid option for F2 matching'
+                WRITE(LO,*) ' PHO_CSINT: invalid option for F2 matching'
                 stop
 *               CALL PHO_HARINT(IP,ECM,PVIRT(1),PVIRT(2),0,
 *    &                          Max_pro_2,3,4,1)
@@ -17657,12 +17679,12 @@ C  assume sig_eff = sigtot
               F2m = F2_fac*SIGeff
               F2s = F2_fac*SIGtmp*FSUP(1)*FSUP(2)
             endif
-*           print LO,' PHO_CSINT: Q2_1,Q2_2,W ',PVIRT(1),PVIRT(2),Ecm
-*           print LO,' PHO_CSINT: F2_mod,F2_pdf,mod/pdf ',F2m,F2,F2m/F2
+*           WRITE(LO,*) ' PHO_CSINT: Q2_1,Q2_2,W ',PVIRT(1),PVIRT(2),Ecm
+*           WRITE(LO,*) ' PHO_CSINT: F2_mod,F2_pdf,mod/pdf ',F2m,F2,F2m/F2
 
 C  global factor to re-scale suppression of soft contributions
             Fcorr = (F2-F2m+F2s)/F2s
-*           print LO,' PHO_CSINT: re-scaling factor: ',Fcorr,FACP*Fcorr
+*           WRITE(LO,*) ' PHO_CSINT: re-scaling factor: ',Fcorr,FACP*Fcorr
             FACP = FACP*Fcorr
 
           endif
@@ -17732,7 +17754,7 @@ C  direct interaction suppressed according to helicity factor
               SIGSRH(1) = (HSig(10)+HSig(11))*FSUH(1)
               SIGSRH(2) = (HSig(12)+HSig(13))*FSUH(2)
             ENDIF
-            print LO,' PHO_CSINT: option not supported yet'
+            WRITE(LO,*) ' PHO_CSINT: option not supported yet'
             stop
           ELSE
 C  rescale relevant hard processes
@@ -20916,12 +20938,12 @@ C  extension to standard particle data interface (PHOJET specific)
           ENDIF
 *       ELSE IF(ISTHEP(I).EQ.20) THEN
 *         IF(ICOLOR(1,I).EQ.-ICOLD) THEN
-*           print LO,' PHO_HARCOR(3): line, old, new:',I,ICOLD,ICNEW
+*           WRITE(LO,*) ' PHO_HARCOR(3): line, old, new:',I,ICOLD,ICNEW
 *           ICOLOR(1,I) = -ICNEW
 *           RETURN
 *         ELSE IF(IDHEP(I).EQ.21) THEN
 *           IF(ICOLOR(2,I).EQ.-ICOLD) THEN
-*             print LO,' PHO_HARCOR(4): line, old, new:',I,ICOLD,ICNEW
+*             WRITE(LO,*) ' PHO_HARCOR(4): line, old, new:',I,ICOLD,ICNEW
 *             ICOLOR(2,I) = -ICNEW
 *             RETURN
 *           ENDIF
       ENDIF
 C  final check
       IF((ABS(IA).GT.NF).OR.(ABS(IB).GT.NF)) THEN
-        print LO,'PHO_HARSCA: rejection, final check IA,IB',IA,IB
-        print LO,'EVENT,MSPR,IA,IB,NF: ',KEVENT,MSPR,IA,IB,NF
+        WRITE(LO,*) 'PHO_HARSCA: rejection, final check IA,IB',IA,IB
+        WRITE(LO,*) 'EVENT,MSPR,IA,IB,NF: ',KEVENT,MSPR,IA,IB,NF
         GOTO 111
       ENDIF
 C
 C  elastic/quasi-elastic scattering
         IF(ISWMDL(13).EQ.0) THEN
 C  external slope values
-          PRINT LO,'PHO_DIFSLP:ERROR: this option is not installed !'
+          WRITE(LO,*) 'PHO_DIFSLP:ERROR: this option is not installed !'
           CALL PHO_ABORT
         ELSE IF(ISWMDL(13).EQ.1) THEN
 C  model slopes
@@ -31836,11 +31858,11 @@ C  rotation into the original direction
     1 IF (ABS(CY)-TINY) 3,3,2
 
     3 CONTINUE
-*     WRITE(LO,*)' PHO_DTRANS CX CY CZ =',CX,CY,CZ
+*     WRITE(LO,*) ' PHO_DTRANS CX CY CZ =',CX,CY,CZ
       CXL=SIZ*COF
       CYL=SIZ*SIF
       CZL=COZ*CZ
-*     WRITE(LO,*)' PHO_DTRANS CXL=SIZ*COF CYL=SIZ*SIF CZL=COZ'
+*     WRITE(LO,*) ' PHO_DTRANS CXL=SIZ*COF CYL=SIZ*SIF CZL=COZ'
 *     WRITE(LO,*) CXL,CYL,CZL
       RETURN
 
@@ -31850,7 +31872,7 @@ C  rotation into the original direction
         AR=AR*AR
         A=AMAX*SQRT(1.D0+AR)
       ELSE
-*       WRITE(LO,*)' PHO_DTRANS AMAX LE TINY2 '
+*       WRITE(LO,*) ' PHO_DTRANS AMAX LE TINY2 '
         GOTO 3
       ENDIF
       XI=SIZ*COF
@@ -33870,7 +33892,7 @@ C  input/output channels
       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
       INTEGER MDCY,MDME,KFDP
       DOUBLE PRECISION  BRAT
-      COMMON/PYDAT3/MDCY(500,3),MDME(4000,2),BRAT(4000),KFDP(4000,5)
+      COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
 
       INTEGER PYCOMP
 
@@ -33889,7 +33911,7 @@ C  defaults
       DEF21 = PARJ(21)
 
 C  declare stable particles
-      IF(IDEFAB.GE.2) MSTJ(22) = 2
+c     IF(IDEFAB.GE.2) MSTJ(22) = 2
 
 C  load optimized parameters
       IF(IDEFAB.GE.3) THEN
@@ -39134,7 +39156,7 @@ CDECK  ID>, PHO_grscalc
       dimension u1(40),ds1(40),g1(40)
       dimension ud2(20),s2(20),g2(20)
       dimension up0(20),dsp0(20),gp0(20)
-      save u1,ds1,g1,ud2,s2,g2,up0,dsp0,gp0
+CPH      save u1,ds1,g1,ud2,s2,g2,up0,dsp0,gp0
 c
       data u1/-0.139d0,0.783d0,0.132d0,0.087d0,0.003d0,-0.0134d0,
      &   0.009d0,-0.017d0,0.092d0,-0.516d0,-0.085d0,0.439d0,
@@ -40521,7 +40543,7 @@ C  input/output channels
       COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
      &XPDIR(-6:6)
       COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6)
-      SAVE /SASCOM/,/SASVAL/
+CPH      SAVE /SASCOM/,/SASVAL/
 
 C...Temporary array.
       DIMENSION XPGA(-6:6), VXPGA(-6:6)