-*\r
-*===program crint======================================================*\r
-*\r
-C OPTIONS/ EXTEND_SOURCE\r
-C SUBROUTINE CRINT\r
- SUBROUTINE DT_PRODUCEEVENT(ENERGY_SL, NPARTICLES)\r
-\r
-\r
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)\r
- REAL ENERGY_SL\r
- INTEGER INIT\r
- REAL ne,etest,prob,slump\r
- SAVE\r
-\r
-* Call the init sub routine in the first event\r
- DATA INIT /0/\r
-\r
- PARAMETER (NMXHKK=200000)\r
-\r
- COMMON /DTIONT/ LINP,LOUT,LDAT\r
-\r
- COMMON /DTEVT1/ NHKK,NEVHKK,ISTHKK(NMXHKK),IDHKK(NMXHKK),\r
- & JMOHKK(2,NMXHKK),JDAHKK(2,NMXHKK),\r
- & PHKK(5,NMXHKK),VHKK(4,NMXHKK),WHKK(4,NMXHKK)\r
-\r
-* event flag\r
- COMMON /DTEVNO/ NEVENT, ICASCA\r
-\r
- IF(INIT.EQ.0) THEN\r
- OPEN (UNIT = 50, file = "my.input") \r
- LINP = 50\r
- CALL DT_DTUINI(NEVTS,EPN,NPMASS,NPCHAR,NTMASS,NTCHAR,IDP,IEMU)\r
-* Init called, make sure it's not called again\r
- INIT = 1\r
- ENDIF\r
-*-----------------------------------------------------------------------\r
-* generation of one event\r
- NEVENT = 1\r
- KKMAT = -1\r
-\r
-* If an energy-range has been defined with the ENERGY input-card the\r
-* laboratory energy ELAB can be set to any value within that range,..\r
-C ELAB = DT_RNDM(EPN)*(EPN-0.5D7)+0.5D7\r
-\r
-* ..otherwise it has to coincide with EPN.\r
-C ELAB = EPN\r
-\r
- ELAB = ENERGY_SL\r
-\r
-* sampling of one event\r
-\r
-* TEST\r
-\r
- CALL DT_KKINC(NPMASS,NPCHAR,NTMASS,NTCHAR,IDP,ELAB,KKMAT,IREJ)\r
-\r
- IF (IREJ.NE.0) RETURN\r
-\r
-c Return the number of particles produced\r
- \r
-c Fill the particle info \r
- CALL DT_GETPARTICLES(NPARTICLES)\r
-\r
- END\r
-\r
-\r
- SUBROUTINE DT_GETPARTICLES(NPARTICLES)\r
-\r
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)\r
- INTEGER pid,qch,q_sum,Ntpc,Nfinal,NACCEPT,IPART,RES\r
- DOUBLE PRECISION yrap,pt,mass,mt,etot\r
- DOUBLE PRECISION pt_cut_tpc\r
- PARAMETER(pt_cut_tpc=0.050)\r
-\r
- SAVE\r
-*\r
-* COMMON /DTEVT1/ :\r
-* NHKK number of entries in common block\r
-* NEVHKK number of the event\r
-* ISTHKK(i) status code for entry i\r
-* IDHKK(i) identifier for the entry\r
-* (for particles: identifier according\r
-* to the PDG numbering scheme)\r
-* JMOHKK(1,i) pointer to the entry of the first mother\r
-* of entry i\r
-* JMOHKK(2,i) pointer to the entry of the second mother\r
-* of entry i\r
-* JDAHKK(1,i) pointer to the entry of the first daughter\r
-* of entry i\r
-* JDAHKK(2,i) pointer to the entry of the second daughter\r
-* of entry i\r
-* PHKK(1..3,i) 3-momentum\r
-* PHKK(4,i) energy\r
-* PHKK(5,i) mass\r
-*\r
-* event history\r
-\r
- PARAMETER (NMXHKK=200000)\r
-\r
- COMMON /DTEVT1/ NHKK,NEVHKK,ISTHKK(NMXHKK),IDHKK(NMXHKK),\r
- & JMOHKK(2,NMXHKK),JDAHKK(2,NMXHKK),\r
- & PHKK(5,NMXHKK),VHKK(4,NMXHKK),WHKK(4,NMXHKK)\r
-\r
-* extended event history\r
- COMMON /DTEVT2/ IDRES(NMXHKK),IDXRES(NMXHKK),NOBAM(NMXHKK),\r
- & IDBAM(NMXHKK),IDCH(NMXHKK),NPOINT(10),\r
- & IHIST(2,NMXHKK)\r
-\r
- DOUBLE PRECISION SLPX, SLPY, SLPZ, SLE, SLM\r
- INTEGER SLPID, SLCHARGE\r
- COMMON /DPMJETPARTICLE/ SLPX(NMXHKK), SLPY(NMXHKK), SLPZ(NMXHKK),\r
- & SLE(NMXHKK), SLM(NMXHKK), SLPID(NMXHKK), SLCHARGE(NMXHKK)\r
-\r
-\r
-C >> Set Counter to Zero\r
-\r
- Nfinal=0\r
- \r
- DO 42 I=1, NHKK\r
-c I = IPART\r
-\r
-CC >> Remove all non-final-state particles\r
- IF(.not.(ISTHKK(I).eq.1.or.ISTHKK(I).eq.-1.or.\r
- $ISTHKK(I).eq.1001)) GOTO 42\r
-\r
-C >> Find Particle Charge, qch\r
- IF((ABS(ISTHKK(I)).eq.1).and.(IDHKK(I).ne.80000))THEN\r
-C >> final state ptcles except nuclei\r
-\r
- qch=IPHO_CHR3(IDHKK(I),1)/3\r
- ELSEIF(IDHKK(I).eq.80000)THEN\r
-C >> final state nuclei\r
- qch=IDXRES(I)\r
- ELSE\r
-C >> not a final state particle, qch not interesting\r
- qch=-999\r
- ENDIF\r
-\r
- Nfinal = Nfinal + 1\r
- SLPX(Nfinal) = PHKK(1,I)\r
- SLPY(Nfinal) = PHKK(2,I)\r
- SLPZ(Nfinal) = PHKK(3,I)\r
- SLE(Nfinal) = PHKK(4,I)\r
- SLM(Nfinal) = PHKK(5,I)\r
- SLPID(Nfinal) = IDHKK(I)\r
- SLCHARGE(Nfinal) = qch\r
-\r
- 42 CONTINUE\r
- NPARTICLES = Nfinal\r
- \r
- END\r
-\r
- SUBROUTINE DT_USRHIS(MODE)\r
-c Dummy to make the linker happy\r
- END\r
-\r
+*
+*===program crint======================================================*
+*
+C OPTIONS/ EXTEND_SOURCE
+C SUBROUTINE CRINT
+ SUBROUTINE DT_PRODUCEEVENT(ENERGY_SL, NPARTICLES)
+
+
+ IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+ REAL ENERGY_SL
+ INTEGER INIT
+ REAL ne,etest,prob,slump
+ SAVE
+
+* Call the init sub routine in the first event
+ DATA INIT /0/
+
+ PARAMETER (NMXHKK=200000)
+
+ COMMON /DTIONT/ LINP,LOUT,LDAT
+
+ COMMON /DTEVT1/ NHKK,NEVHKK,ISTHKK(NMXHKK),IDHKK(NMXHKK),
+ & JMOHKK(2,NMXHKK),JDAHKK(2,NMXHKK),
+ & PHKK(5,NMXHKK),VHKK(4,NMXHKK),WHKK(4,NMXHKK)
+
+* event flag
+ COMMON /DTEVNO/ NEVENT, ICASCA
+
+ IF(INIT.EQ.0) THEN
+ OPEN (UNIT = 50, file = "my.input")
+ LINP = 50
+ CALL DT_DTUINI(NEVTS,EPN,NPMASS,NPCHAR,NTMASS,NTCHAR,IDP,IEMU)
+* Init called, make sure it's not called again
+ INIT = 1
+ ENDIF
+*-----------------------------------------------------------------------
+* generation of one event
+ NEVENT = 1
+ KKMAT = -1
+
+* If an energy-range has been defined with the ENERGY input-card the
+* laboratory energy ELAB can be set to any value within that range,..
+C ELAB = DT_RNDM(EPN)*(EPN-0.5D7)+0.5D7
+
+* ..otherwise it has to coincide with EPN.
+C ELAB = EPN
+
+ ELAB = ENERGY_SL
+
+* sampling of one event
+
+* TEST
+
+ CALL DT_KKINC(NPMASS,NPCHAR,NTMASS,NTCHAR,IDP,ELAB,KKMAT,IREJ)
+
+ IF (IREJ.NE.0) RETURN
+
+c Return the number of particles produced
+
+c Fill the particle info
+ CALL DT_GETPARTICLES(NPARTICLES)
+
+ END
+
+
+ SUBROUTINE DT_GETPARTICLES(NPARTICLES)
+
+ IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+ INTEGER pid,qch,q_sum,Ntpc,Nfinal,NACCEPT,IPART,RES
+ DOUBLE PRECISION yrap,pt,mass,mt,etot
+ DOUBLE PRECISION pt_cut_tpc
+ PARAMETER(pt_cut_tpc=0.050)
+
+ SAVE
+*
+* COMMON /DTEVT1/ :
+* NHKK number of entries in common block
+* NEVHKK number of the event
+* ISTHKK(i) status code for entry i
+* IDHKK(i) identifier for the entry
+* (for particles: identifier according
+* to the PDG numbering scheme)
+* JMOHKK(1,i) pointer to the entry of the first mother
+* of entry i
+* JMOHKK(2,i) pointer to the entry of the second mother
+* of entry i
+* JDAHKK(1,i) pointer to the entry of the first daughter
+* of entry i
+* JDAHKK(2,i) pointer to the entry of the second daughter
+* of entry i
+* PHKK(1..3,i) 3-momentum
+* PHKK(4,i) energy
+* PHKK(5,i) mass
+*
+* event history
+
+ PARAMETER (NMXHKK=200000)
+
+ COMMON /DTEVT1/ NHKK,NEVHKK,ISTHKK(NMXHKK),IDHKK(NMXHKK),
+ & JMOHKK(2,NMXHKK),JDAHKK(2,NMXHKK),
+ & PHKK(5,NMXHKK),VHKK(4,NMXHKK),WHKK(4,NMXHKK)
+
+* extended event history
+ COMMON /DTEVT2/ IDRES(NMXHKK),IDXRES(NMXHKK),NOBAM(NMXHKK),
+ & IDBAM(NMXHKK),IDCH(NMXHKK),NPOINT(10),
+ & IHIST(2,NMXHKK)
+
+ DOUBLE PRECISION SLPX, SLPY, SLPZ, SLE, SLM
+ INTEGER SLPID, SLCHARGE
+ COMMON /DPMJETPARTICLE/ SLPX(NMXHKK), SLPY(NMXHKK), SLPZ(NMXHKK),
+ & SLE(NMXHKK), SLM(NMXHKK), SLPID(NMXHKK), SLCHARGE(NMXHKK)
+
+
+C >> Set Counter to Zero
+
+ Nfinal=0
+
+ DO 42 I=1, NHKK
+c I = IPART
+
+CC >> Remove all non-final-state particles
+ IF(.not.(ISTHKK(I).eq.1.or.ISTHKK(I).eq.-1.or.
+ $ISTHKK(I).eq.1001)) GOTO 42
+
+C >> Find Particle Charge, qch
+ IF((ABS(ISTHKK(I)).eq.1).and.(IDHKK(I).ne.80000))THEN
+C >> final state ptcles except nuclei
+
+ qch=IPHO_CHR3(IDHKK(I),1)/3
+ ELSEIF(IDHKK(I).eq.80000)THEN
+C >> final state nuclei
+ qch=IDXRES(I)
+ ELSE
+C >> not a final state particle, qch not interesting
+ qch=-999
+ ENDIF
+
+ Nfinal = Nfinal + 1
+ SLPX(Nfinal) = PHKK(1,I)
+ SLPY(Nfinal) = PHKK(2,I)
+ SLPZ(Nfinal) = PHKK(3,I)
+ SLE(Nfinal) = PHKK(4,I)
+ SLM(Nfinal) = PHKK(5,I)
+ SLPID(Nfinal) = IDHKK(I)
+ SLCHARGE(Nfinal) = qch
+
+ 42 CONTINUE
+ NPARTICLES = Nfinal
+
+ END
+
+ SUBROUTINE DT_USRHIS(MODE)
+c Dummy to make the linker happy
+ END
+
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff