C*********************************************************************** PROGRAM DPMJET IMPLICIT DOUBLE PRECISION (A-H,O-Z) #include "stdlun.inc" #include "hkkevt.inc" #include "dpm_dpar.inc" #include "dpm_nucc.inc" #include "dpm_cmhico.inc" #include "dpm_resona.inc" #include "dpm_dprin.inc" #include "dpm_rejec.inc" #include "dpm_droppt.inc" #include "dpm_dnun.inc" #include "dpm_nshmak.inc" c *KEND. COMMON /SEAQXX/ SEAQX,SEAQXN COMMON /DIFFRA/ ISINGD,IDIFTP,IOUDIF,IFLAGD COMMON /EVFLAG/ NUMEV COMMON /NEUTYY/ NEUTYP COMMON /FLUCTU/IFLUCT COMMON /DIQREJ/IDIQRE(7) COMMON /HBOO/IHBOOK C modified DPMJET COMMON /BUFUES/ BNNVV,BNNSS,BNNSV,BNNVS,BNNCC, * BNNDV,BNNVD,BNNDS,BNNSD, * BNNHH,BNNZZ, * BPTVV,BPTSS,BPTSV,BPTVS,BPTCC,BPTDV, * BPTVD,BPTDS,BPTSD, * BPTHH,BPTZZ, * BEEVV,BEESS,BEESV,BEEVS,BEECC,BEEDV, * BEEVD,BEEDS,BEESD, * BEEHH,BEEZZ * ,BNNDI,BPTDI,BEEDI * ,BNNZD,BNNDZ,BPTZD,BPTDZ,BEEZD,BEEDZ COMMON /NCOUCS/ BCOUVV,BCOUSS,BCOUSV,BCOUVS, * BCOUZZ,BCOUHH,BCOUDS,BCOUSD, * BCOUDZ,BCOUZD,BCOUDI, * BCOUDV,BCOUVD,BCOUCC COMMON /BUFUEH/ ANNVV,ANNSS,ANNSV,ANNVS,ANNCC, * ANNDV,ANNVD,ANNDS,ANNSD, * ANNHH,ANNZZ, * PTVV,PTSS,PTSV,PTVS,PTCC,PTDV,PTVD,PTDS,PTSD, * PTHH,PTZZ, * EEVV,EESS,EESV,EEVS,EECC,EEDV,EEVD,EEDS,EESD, * EEHH,EEZZ * ,ANNDI,PTDI,EEDI * ,ANNZD,ANNDZ,PTZD,PTDZ,EEZD,EEDZ COMMON /NCOUCH/ ACOUVV,ACOUSS,ACOUSV,ACOUVS, * ACOUZZ,ACOUHH,ACOUDS,ACOUSD, * ACOUDZ,ACOUZD,ACOUDI, * ACOUDV,ACOUVD,ACOUCC COMMON/POPCCK/PDBCK,PDBSE,IJPOCK,IREJCK,ICK4,IHAD4,ICK6,IHAD6 *,IREJSE,ISE4,ISE6 COMMON /ROEH/IROEH COMMON /NSTARI/NSTART DIMENSION PP(4) C--------------------- * DATA NCOUNT/0/ C from DTUJET93 C from DTUJET93 C ON DOUBLE PRECISION UNDERFLOW IGNORE C ON DOUBLE PRECISION OVERFLOW IGNORE C ON DOUBLE PRECISION INEXACT IGNORE C ON DOUBLE PRECISION ILLEGAL IGNORE C ON DOUBLE PRECISION DIV 0 IGNORE C ON REAL UNDERFLOW IGNORE C ON REAL OVERFLOW IGNORE C ON INTEGER OVERFLOW IGNORE C ON REAL INEXACT IGNORE C ON REAL ILLEGAL IGNORE C ON REAL DIV 0 IGNORE C from DTUJET93 *---extended error handling on RISC 6000 C include 'fexcp.h' C call signal(SIGTRAP,xl_trce) C***********************************************************************a integer nevt,i,nprnt,lok,istr c nevt=100 nprnt=1 C initialize HEP logical units lnhwrt=23 lnhrd=0 lnhdcy=0 lnhout=22 open(unit=lnhout,file='stdtst_dpm.lpt',status='new') call stdxwinit('stdtst_dpm.io','StdHep/DPMJET example', 1 nevt,istr,lok) C IDIQRE(1)=0 IDIQRE(2)=0 IDIQRE(3)=0 IDIQRE(4)=0 IDIQRE(5)=0 IDIQRE(6)=0 IDIQRE(7)=0 cc 1000 CONTINUE NCOUNT=NCOUNT+1 * initialisation routine: C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C Parton pt distribution CALL PARPT(1,PT1,PT2,IPT,NEVT) C------------------------------------------------------------- CALL DMINIT(NCASES,EPN,PPN,NCOUNT,IGLAUB) C---------------------------------------------------------------- call hptrlstdpm C---now starts the real work NHKKH1=1 ISHMAL=.TRUE. C TTOT=0. TMAX=0. C CALL TIMEL (TCPU) C TLIM=MAX(TCPU/100.,15.) C CALL TIMED(TDIFF) IIT=IT IITZ=ITZ IIP=IP IIPZ=IPZ IIPROJ=IJPROJ IITARG=IJTARG IF( IGLAUB.EQ.1) THEN KKMAT=0 ELSE KKMAT=1 ENDIF NCASET=NCASES/10 DO 181 IIII=1,10 NDONE=(IIII-1)*NCASET WRITE(6,1111)NDONE WRITE(6,'(A,4I5)')' KKINC call ',IIT,IITZ,IIP,IIPZ CALL TIMDAT 1111 FORMAT(' NDONE= ',I10) DO 180 I=1,NCASET 765 CONTINUE NUMEV = I+(IIII-1)*NCASET IF ((I.EQ.486).OR.(I.EQ.803).OR.(I.EQ.1368).OR. & (I.EQ.1465).OR.(I.EQ.1693).OR.(I.EQ.1808)) THEN C IPEV = 7 C IPCO = 7 C IPHKK = 7 ENDIF C INITIALIZE COUNTERS ANNVV=0.001 ANNSS=0.001 ANNSV=0.001 ANNVS=0.001 ANNCC=0.001 ANNDV=0.001 ANNVD=0.001 ANNDS=0.001 ANNSD=0.001 ANNHH=0.001 ANNZZ=0.001 ANNDI=0.001 ANNZD=0.001 ANNDZ=0.001 PTVV=0. PTSS=0. PTSV=0. PTVS=0. PTCC=0. PTDV=0. PTVD=0. PTDS=0. PTSD=0. PTHH=0. PTZZ=0. PTDI=0. PTZD=0. PTDZ=0. EEVV=0. EESS=0. EESV=0. EEVS=0. EECC=0. EEDV=0. EEVD=0. EEDS=0. EESD=0. EEHH=0. EEZZ=0. EEDI=0. EEZD=0. EEDZ=0. C COMMON /NCOUCH/ ACOUVV,ACOUSS,ACOUSV,ACOUVS, C * ACOUZZ,ACOUHH,ACOUDS,ACOUSD, C * ACOUDZ,ACOUZD,ACOUDI ACOUVV=0. ACOUSS=0. ACOUSV=0. ACOUVS=0. ACOUZZ=0. ACOUHH=0. ACOUDS=0. ACOUSD=0. ACOUDZ=0. ACOUZD=0. ACOUDI=0. ACOUDV=0. ACOUVD=0. ACOUCC=0. * C IIP=IP+1-IIII C WRITE(6,'(A,4I5)')' KKINC call ',IIT,IITZ,IIP,IIPZ CALL KKINC(EPN,IIT,IITZ,IIP,IIPZ,IIPROJ,KKMAT, * IITARG,NHKKH1,IREJ) C CALL TIMDAT IF(IREJ.EQ.1)GO TO 765 C IPEV = 0 C IPCO = 0 C IPHKK = 0 C INITIALIZE COUNTERS BNNVV=BNNVV+ANNVV BNNSS=BNNSS+ANNSS BNNSV=BNNSV+ANNSV BNNVS=BNNVS+ANNVS BNNCC=BNNCC+ANNCC BNNDV=BNNDV+ANNDV BNNVD=BNNVD+ANNVD BNNDS=BNNDS+ANNDS BNNSD=BNNSD+ANNSD BNNHH=BNNHH+ANNHH BNNZZ=BNNZZ+ANNZZ BNNDI=BNNDI+ANNDI BNNZD=BNNZD+ANNZD BNNDZ=BNNDZ+ANNDZ BPTVV=BPTVV+PTVV BPTSS=BPTSS+PTSS BPTSV=BPTSV+PTSV BPTVS=BPTVS+PTVS BPTCC=BPTCC+PTCC BPTDV=BPTDV+PTDV BPTVD=BPTVD+PTVD BPTDS=BPTDS+PTDS BPTSD=BPTSD+PTSD BPTHH=BPTHH+PTHH BPTZZ=BPTZZ+PTZZ BPTDI=BPTDI+PTDI BPTZD=BPTDZ+PTDZ BPTDZ=BPTDZ+PTDZ BEEVV=BEEVV+EEVV BEESS=BEESS+EESS BEESV=BEESV+EESV BEEVS=BEEVS+EEVS BEECC=BEECC+EECC BEEDV=BEEDV+EEDV BEEVD=BEEVD+EEVD BEEDS=BEEDS+EEDS BEESD=BEESD+EESD BEEHH=BEEHH+EEHH BEEZZ=BEEZZ+EEZZ BEEDI=BEEDI+EEDI BEEZD=BEEZD+EEZD BEEDZ=BEEDZ+EEDZ C COMMON /NCOUCH/ ACOUVV,ACOUSS,ACOUSV,ACOUVS, C * ACOUZZ,ACOUHH,ACOUDS,ACOUSD, C * ACOUDZ,ACOUZD,ACOUDI BCOUVV=BCOUVV+ACOUVV BCOUSS=BCOUSS+ACOUSS BCOUSV=BCOUSV+ACOUSV BCOUVS=BCOUVS+ACOUVS BCOUZZ=BCOUZZ+ACOUZZ BCOUHH=BCOUHH+ACOUHH BCOUDS=BCOUDS+ACOUDS BCOUSD=BCOUSD+ACOUSD BCOUDZ=BCOUDZ+ACOUDZ BCOUZD=BCOUZD+ACOUZD BCOUDI=BCOUDI+ACOUDI BCOUDV=BCOUDV+ACOUDV BCOUVD=BCOUVD+ACOUVD BCOUCC=BCOUCC+ACOUCC * C HOW LONG DID IT TAKE TO PROCESS THIS ONE? C C CALL TIMED(TDIFF) C IF(TDIFF.GT.TMAX)TMAX=TDIFF C TTOT=TTOT+TDIFF C TMEAN=TTOT/FLOAT(I) C C CONDITIONS FOR LOOP TERMINATION C C CALL TIMEL(TLEFT) C IF ( TLEFT .LE. 3.*TMAX+TLIM ) GO TO 190 c.... fill hepevt common block and write out event call dpmhep(1) call stdxwrt(1,istr,LOK) 180 CONTINUE 181 CONTINUE GO TO 200 190 CONTINUE C WRITE(6,*)' STOPPED FOR CPUTIME LIMIT: ',I,' EVENTS ', C +'INSTEAD OF ',NCASES,' PRODUCED' C NCASES = I 200 CONTINUE C WRITE (6,1090)TTOT,TMAX,TCPU,TLIM,TDIF,TMEAN,TLEFT C1090 FORMAT (' TTOT,TMAX,TCPU,TLIM,TDIF,TMEAN.TLEFT '/7F10.2) C IF(IPEV.GE.-1) THEN WRITE(6,1100) IRVV11,IRVV12,IRVV13,IRVV14, IRSV11,IRSV12,IRSV13, + IRSV14, IRVS11,IRVS12,IRVS13,IRVS14, IRSS11,IRSS12,IRSS13,IRSS14 1100 FORMAT (' REJECTION COUNTERS FROM KKEVT',/, 5X,' V-V CHAINS',4I6/ +5X,' S-V CHAINS',4I6/ 5X,' V-S CHAINS',4I6/ 5X,' S-S CHAINS',4I6) WRITE(6,'(A,2I10)')' POPCCK/SE rejections ',IREJCK,IREJSE WRITE(6,'(A,6I6)')' POPCCK ICK4,ICK6,IHAD4,IHAD6,ISE4,ISE6 ', * ICK4,ICK6,IHAD4,IHAD6,ISE4,ISE6 ENDIF C CALL TIMDAT C****************** PRINTOUT******************************** WRITE(6,'(A,7I5)')' Diquark rejection,N,ss,su,ud', & (IDIQRE(JJ),JJ=1,7) IF ((CMHIS.EQ.1.D0).AND.(IOUDIF.EQ.1)) & CALL DIADIF(3,NHKKH1) * IF(IPADIS) CALL DISTPA(3) CALL PARPT(3,PT1,PT2,IPT,NCASES) IF(ISHMAL) CALL SHMAK(3,NSHMAC,NP,NT,IP,IT) IF (IRESO.EQ.1) CALL DISTRP(3,NCASES,PPN) IF (CMHIS.EQ.0.D0.AND.IROEH.EQ.1) CALL HISTOG(3) IF (CMHIS.EQ.0.D0) CALL DISTR(3,NCASES,PPN,IDUMMY) IF (CMHIS.EQ.1.D0) CALL DISTRC(3,NCASES,PPN,IDUMMY) IF (CMHIS.EQ.2.D0) CALL DISTCO(3,NCASES,PPN,IDUMMY) IF (IRESO.EQ.1) CALL DISRES(3,NCASES,PPN) C HBOOK HISTOGRAMS C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ IF(IHBOOK.EQ.1.AND.CMHIS.EQ.0.D0)THEN CALL PLOMB(5,PP,CHAR,XFXFXF,ITIF,IJPROJ) ENDIF IF(IHBOOK.EQ.1.AND.CMHIS.EQ.1.D0)THEN CALL PLOMBC(5,PP,CHAR,XFXFXF,ITIF,IJPROJ) ENDIF C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++ CALL TIMDAT C C---------------------------------------------------------------- cc GO TO 1000 c don't loop after generating events c...close event file call stdxend(istr) c...close output file close(unit=lnhout) END C