IAP GITLAB

Commit 2f1a425e authored by Tanguy Pierog's avatar Tanguy Pierog

add modifications in interface. Now running.

parent 6ee7c4b6
......@@ -239,7 +239,11 @@ C common /DTVDMP/
C common /DTGLGP/
JSTatb = 1000
JBInsb = 49
#ifndef FOR_CORSIKA
CGLb = ' '
#else
cdh do not overwrite the glauber data set name of corsika
#endif
IF ( ITRspt.EQ.1 ) THEN
IOGlb = 100
ELSE
......
......@@ -228,6 +228,10 @@ C LEPTO: pick out one struck nucleon
GOTO 300
END IF
#ifdef FOR_CORSIKA
if (LPRI.GT.4) write(LOUT,*)'DT_DIAGR: before loop 4'
#endif
DO ina = 1 , Na
C cross section fluctuations
afluc = ONE
......@@ -348,4 +352,8 @@ C supress Glauber-cascade by direct photon processes
nwb(Intb) = nwb(Intb) + 1
END IF
#ifdef FOR_CORSIKA
if (LPRI.GT.4) write(LOUT,*)'DT_DIAGR: at end'
#endif
END SUBROUTINE
......@@ -24,7 +24,10 @@ C***********************************************************************
INTEGER i , id , idchk , IDT_IPDGHA , idum , idxmor , iflg ,
& ifrg , ih1 , ih2 , ihismo , ii , ij , ijk , ijoin ,
& iniemc , ip , ipje , Irej
INTEGER irej1 , irej3 , isdrn1 , isdrn2 , iseed1 , iseed2 , ish ,
#ifndef FOR_CORSIKA
INTEGER isdrn1 , isdrn2 , iseed1 , iseed2
#endif
INTEGER irej1 , irej3 , ish ,
& isjoin , ismor , istsrg , iststg , jdaug , k1 , k2 ,
& kfmor , kk , Kmode
INTEGER mo , mode , MXJOIN , naccep , nend , Nfrg , nlines ,
......@@ -71,11 +74,17 @@ C jetset
LOGICAL LDBgpr
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,*)
WRITE (77,'(A,5I6)') ' EVTFRG IN:' , Kmode , Nfrg , Npymem ,
& Irej , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,*)
WRITE (LOUT,'(A,5I6)')
& ' DT_EVTFRG IN:',KMODE,NFRG,NPYMEM,IREJ,NHKK
#endif
END IF
mode = Kmode
iststg = 7
......@@ -97,10 +106,15 @@ C & ((NOBAM(I).NE.0).AND.(MODE.EQ.2))
C pick up chains from dtevt1
idchk = IDHkk(i)/10000
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,6I6)') ' EVTFRG LACCEP:' , i , NPOint(3) ,
& NPOint(4) , idchk , istsrg , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,6I6)')
& ' DT_EVTFRG LACCEP:',I,NPOINT(3),NPOINT(4),IDCHK,ISTSRG,NHKK
#endif
END IF
IF ( (idchk.EQ.iststg) .AND. laccep ) THEN
IF ( idchk.EQ.7 ) THEN
......@@ -123,10 +137,15 @@ C & ICCHAI(2,IDCH(I)) = ICCHAI(2,IDCH(I))+1
C IF (IDRES(I).NE.0) ICRES(IDCH(I)) = ICRES(IDCH(I))+1
C special treatment for small chains already corrected to hadrons
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,4I6)') ' EVTFRG NO GOTO 16:' , IDRes(i) ,
& ifrg , Nfrg , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,4I6)')
& ' DT_EVTFRG NO GOTO 16:',IDRES(I),IFRG,NFRG,NHKK
#endif
END IF
IF ( IDRes(i).NE.0 ) THEN
IF ( IDRes(i).EQ.11 ) THEN
......@@ -138,11 +157,17 @@ C special treatment for small chains already corrected to hadrons
CALL DT_EVTEMC(PHKk(1,i),PHKk(2,i),PHKk(3,i),PHKk(4,i)
& ,iniemc,idum,idum)
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,4I6,/,1P,4G23.15)')
& ' EVTFRG EVTEMC:' , i , IDHkk(i) , iniemc ,
& NHKk , (PHKk(ijk,i),ijk=1,4)
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,4I6,/,1P,4G23.15)')
& ' DT_EVTFRG EVTEMC:',I,IDHKK(I),INIEMC,NHKK,
& (PHKK(IJK,I),IJK=1,4)
#endif
END IF
iniemc = 2
END IF
......@@ -176,18 +201,29 @@ C special treatment for small chains already corrected to hadrons
CALL DT_EVTEMC(PHKk(1,kk),PHKk(2,kk),PHKk(3,kk),
& PHKk(4,kk),iniemc,idum,idum)
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,4I6,/,1P,4G23.15)')
& ' EVTFRG EVTEMC-2:' , kk , IDHkk(kk) ,
& iniemc , NHKk , (PHKk(ijk,kk),ijk=1,4)
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,4I6,/,1P,4G23.15)')
& ' DT_EVTFRG EVTEMC-2:',KK,IDHKK(KK),INIEMC,NHKK,
& (PHKK(IJK,KK),IJK=1,4)
#endif
END IF
CALL DT_EVTFLC(IDHkk(kk),1,iniemc,idum,idum)
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,4I6)') ' EVTFRG EVTFLC:' , kk ,
& IDHkk(kk) , iniemc , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,4I6)')
& ' DT_EVTFRG EVTFLC:',KK,IDHKK(KK),INIEMC,NHKK
#endif
END IF
iniemc = 2
END IF
......@@ -244,9 +280,14 @@ C join the two-parton system
CALL PYJOIN(ij,ijoin)
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6)') ' EVTFRG PYJOIN:' , ij , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6)')
& ' EVTFRG PYJOIN:',IJ,NHKK
#endif
END IF
END IF
IDHkk(i) = 99999
......@@ -281,10 +322,15 @@ C final state parton shower
rqlun = MIN(pt1,pt2)
CALL PYSHOW(ih1,ih2,rqlun)
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6,1P,G23.15)')
& ' EVTFRG PYSHOW:' , ih1 , ih2 , rqlun
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6,1P,G23.15)')
& ' EVTFRG PYSHOW:',IH1,IH2,RQLUN
#endif
END IF
isjoin(k1) = 0
......@@ -304,17 +350,27 @@ C final state parton shower
CALL DT_INITJS(mode)
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6)') ' EVTFRG INITJS:' , mode , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6)')
& ' EVTFRG INITJS:',MODE,NHKK
#endif
END IF
C hadronization
CALL PYEXEC
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6)') ' EVTFRG PYEXEC:' , MSTu(24) , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6)')
& ' EVTFRG PYEXEC:',MSTU(24),NHKK
#endif
END IF
IF ( MSTu(24).NE.0 ) THEN
......@@ -411,9 +467,14 @@ C there was no mother resonance
END IF
END DO
IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6)') ' EVTFRG 13:' , nlines , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6)')
& ' EVTFRG 13:',NLINES,NHKK
#endif
END IF
IF ( LEMcck ) THEN
chklev = TINY1
......
......@@ -440,7 +440,11 @@ C the following patch is required to transmit the correct excitation
C energy to Eventd
IF ( ITRspt.EQ.1 ) THEN
IF ( ABS(amrcl(i)-AMRcl0(i)-EEXc(i)).GT.1.D-04 )
#ifndef FOR_CORSIKA
& WRITE (77,*)
#else
& WRITE (LOUT,*)
#endif
& ' DT_FICONF:AMRCL(I),AMRCL0(I),EEXC(I)' ,
& amrcl(i) , AMRcl0(i) , EEXc(i)
prcl0 = prcl(i,4)
......
......@@ -54,6 +54,9 @@ C get actual energy from /DTLTRA/
ECMnow = UMO
Q2 = VIRt
C
#ifdef FOR_CORSIKA
if (LPRI.GT.4) write(LOUT,*)'DT_GLAUBE:IOGLB=',IOGLB,' NIDX=',NIDX
#endif
C new patch for pre-initialized variable projectile/target/energy runs
IF ( IOGlb.NE.100 ) THEN
i1 = 1
......
......@@ -29,6 +29,13 @@ C emulsion treatment
INCLUDE 'inc/dtcomp'
C Glauber formalism: flags and parameters for statistics
INCLUDE 'inc/dtglgp'
#ifdef FOR_CORSIKA
cdh datadir for path to the data sets to be read in by dpmjet/phojet
COMMON /DATADIR/ DATADIR
CHARACTER*132 DATADIR
#endif
C number of data sets other than protons and nuclei
C at the moment = 2 (pions and kaons)
PARAMETER (MAXOFF=2)
......@@ -87,7 +94,13 @@ C open Glauber-data output file
idx = INDEX(CGLb,' ')
k = 8
IF ( idx.GT.1 ) k = idx - 1
#ifndef FOR_CORSIKA
OPEN (LDAt,FILE=CGLb(1:k)//'.glb',STATUS='UNKNOWN')
#else
c modification for use with corsika using path to data file in DATADIR
OPEN(LDAT,STATUS='UNKNOWN',
& FILE=DATADIR(1:INDEX(DATADIR,' ')-1)//CGLB(1:K)//'.glb')
#endif
C
C--------------------------------------------------------------------------
C Glauber-initialization for proton and nuclei projectiles
......
......@@ -37,6 +37,13 @@ C Glauber formalism: parameters
INCLUDE 'inc/dtglam'
C Glauber formalism: cross sections
INCLUDE 'inc/dtglxs'
#ifdef FOR_CORSIKA
cdh datadir for path to the data sets to be read in by dpmjet/phojet
COMMON /DATADIR/ DATADIR
CHARACTER*132 DATADIR
#endif
C number of data sets other than protons and nuclei
C at the moment = 2 (pions and kaons)
PARAMETER (MAXOFF=2)
......@@ -84,11 +91,21 @@ C
idx = INDEX(CGLb,' ')
k = 12
IF ( idx.GT.1 ) k = idx - 1
#ifndef FOR_CORSIKA
OPEN (LDAt,FILE=CGLb(1:k)//'.glb',STATUS='UNKNOWN')
IF ( LPRi.GT.4 ) WRITE (LOUt,99010) CGLb(1:k)//'.glb'
99010 FORMAT (/,' GLBSET: impact parameter distributions read from ',
& 'file ',A12,/)
#else
c modification for use with corsika using path to data file in DATADIR
IF (LPRI.GT.4)
& WRITE(LOUT,*)'DT_GLBSET:read glauber parameter from file ',
& DATADIR(1:INDEX(DATADIR,' ')-1)//CGLB(1:K),'.glb',' K=',K
OPEN(LDAT,STATUS='UNKNOWN',
& FILE=DATADIR(1:INDEX(DATADIR,' ')-1)//CGLB(1:K)//'.glb')
#endif
C
C read binning information
READ (LDAt,'(I4,2X,2E13.5)') nebin , elo , ehi
......
......@@ -14,7 +14,7 @@ C***********************************************************************
DOUBLE PRECISION xlim2 , xlim3 , xmod , xseaco , ZERO
INTEGER i , ibin , ichain , icw , idip , idit , Idp , idt , idum ,
& idum1 , ifirst , Iglau , ihdum , ihshma , ii , iip , iit ,
& inseed , iplow , ippn
& iplow , ippn
INTEGER iprang , iratio , irej1 , itlow , iwhat ,
& iwhat1 , iwhat2 , ixsqel , j ,
& k , kc , kframe , MXCARD , na1 , na2
......@@ -23,7 +23,7 @@ C***********************************************************************
#ifdef FOR_FLUKA
INTEGER iseed1 , iseed2 , isrnd1 , isrnd2
INTEGER inseed , iseed1 , iseed2 , isrnd1 , isrnd2
#endif
SAVE
......@@ -196,6 +196,47 @@ C in this case Epn is expected to carry the beam momentum
lext = .TRUE.
GOTO 300
END IF
#else
#ifdef FOR_CORSIKA
IF (NCASES.LE.-1) THEN !variable energy with air (TP20170630)
IP = NPMASS
IPZ = NPCHAR
IT = NTMASS
ITZ = NTCHAR
PPN = EPNSAV
VARELO = 10.D0
VAREHI = PPN*1.1D0
EPN = ZERO
CMENER = ZERO
LEINP = .TRUE.
MKCRON = 0
WHAT(1) = 1
WHAT(2) = 0
CODEWD = 'START '
lext = .TRUE.
LEVPRT = .TRUE.
IF(NCASES.EQ.-2)THEN
IOGLB = 0 ! don't use glauber tables
ELSE
IOGLB = 100 ! use glauber tables
ENDIF
GOTO 300
ELSEIF (NCASES.EQ.-100) THEN !make glauber table
if(ifirst.ne.1)stop
ifirst=2
IP = NPMASS
IPZ = NPCHAR
IT = NTMASS
ITZ = NTCHAR
PPN = EPNSAV
WHAT(1) = 10.D0
WHAT(2) = PPN*1.1D0
WHAT(3) = 7d0
WHAT(4) = 56d0
WHAT(5) = 7d0
CODEWD = 'GLAUB-INI'
goto 300
ENDIF
#else
IF ( Ncases.EQ.-1 ) THEN
IP = Npmass
......@@ -217,6 +258,7 @@ C in this case Epn is expected to carry the beam momentum
GOTO 300
END IF
#endif
#endif
C read control card from input-unit LINP
READ (LINp,'(A78)',END=400) cline
IF ( cline(1:1).EQ.'*' ) THEN
......
......@@ -78,6 +78,12 @@ C VDM parameter for photon-nucleus interactions
C parameters for hA-diffraction
INCLUDE 'inc/dtdiha'
#ifdef FOR_CORSIKA
cdh datadir for path to the data sets to be read in by dpmjet/phojet
COMMON /DATADIR/ DATADIR
CHARACTER*132 DATADIR
#endif
COMPLEX*16 pp11(MAXNCL) , pp12(MAXNCL) , pp21(MAXNCL) ,
& pp22(MAXNCL) , ompp11 , ompp12 , ompp21 , ompp22 ,
& dipp11 , dipp12 , dipp21 , dipp22 , avdipp , pptmp1 ,
......@@ -106,10 +112,22 @@ C not needed for these interactions..
i = INDEX(CGLb,' ')
IF ( i.EQ.0 ) THEN
cfile = CGLb//'.glb'
#ifndef FOR_CORSIKA
OPEN (LDAt,FILE=CGLb//'.glb',STATUS='UNKNOWN')
#else
c modification for use with corsika using path to data file in DATADIR
OPEN(LDAT,STATUS='UNKNOWN',
& FILE=DATADIR(1:INDEX(DATADIR,' ')-1)//CGLB//'.glb')
#endif
ELSE IF ( i.GT.1 ) THEN
cfile = CGLb(1:i-1)//'.glb'
#ifndef FOR_CORSIKA
OPEN (LDAt,FILE=CGLb(1:i-1)//'.glb',STATUS='UNKNOWN')
#else
c modification for use with corsika using path to data file in DATADIR
OPEN(LDAT,STATUS='UNKNOWN',
& FILE=DATADIR(1:INDEX(DATADIR,' ')-1)//CGLB(1:I-1)//'.glb')
#endif
ELSE
STOP 'XSGLAU 1'
END IF
......
......@@ -63,6 +63,9 @@ C interpolation tables for hard cross section and MC selection weights
INCLUDE 'inc/pohtab'
#else
INCLUDE 'inc/pohtab50'
cdh datadir for path to the data sets to be read in by dpmjet/phojet
COMMON /DATADIR/ DATADIR
CHARACTER*132 DATADIR
#endif
C initialize /POCONS/
......@@ -528,10 +531,15 @@ C max. iteration number in PHO_SELSXI
IPAmdl(183) = 50
C Default directory for data files
#ifndef FOR_CORSIKA
IF ( LENdir.EQ.0 ) THEN
DATDir = 'dpmdata/'
LENDir = 8
END IF
#else
LENDir = INDEX(DATADIR,' ')
DATDir = DATADIR(1:LENDir-1)//'/'
#endif
C Parameter file path
IF ( INDEX(PARfn,'.dat').EQ.0 ) PARfn =
& DATdir(1:LENdir)//'dpmjpar.dat'
......
......@@ -37,6 +37,10 @@ C (Anti-)Particle combination assumed to be known
DATA ifast/0/
#else
DATA ifast/0/
#endif
#ifdef FOR_CORSIKA
INTEGER ISTART
DATA ISTART / 0 /
#endif
SAVE
......@@ -47,6 +51,14 @@ C (Anti-)Particle combination assumed to be known
ipds1 = IFPap(1)
ipds2 = IFPap(2)
#ifdef FOR_CORSIKA
if ( LPRI.GT.4) then
if (istart .eq. 0 ) then
write(LO,*) 'PHO_SETPCOMB: IFAST=',IFAST
istart = 1
endif
endif
#endif
IF ( (IDEqp(1).NE.0) .AND. (IDEqp(1).NE.ipds1) ) THEN
iremn1 = -1
......
......@@ -67,7 +67,11 @@ C...Check x and particle species.
&KFA.NE.211.AND.KFA.NE.2112.AND.KFA.NE.2212.AND.KFA.NE.3122.AND.
&KFA.NE.3112.AND.KFA.NE.3212.AND.KFA.NE.3222.AND.KFA.NE.3312.AND.
&KFA.NE.3322.AND.KFA.NE.3334.AND.KFA.NE.111.AND.KFA.NE.321.AND.
#ifndef FOR_CORSIKA
&KFA.NE.310.AND.KFA.NE.130) THEN
#else
&KFA.NE.310.AND.KFA.NE.130.AND.KFA.NE.221.AND.KFA.NE.331) THEN
#endif
WRITE(MSTU(11),5100) KF
GOTO 9999
ENDIF
......
......@@ -35,9 +35,25 @@ C...Preliminaries. Parton composition.
IF(MINT(105).EQ.333) KFL(2)=3
IF(MINT(105).EQ.443) KFL(2)=4
KFL(3)=KFL(2)
#ifndef FOR_CORSIKA
ELSEIF((KFA.EQ.111.OR.KFA.EQ.113).AND.PYR(0).GT.0.5D0) THEN
KFL(2)=2
KFL(3)=2
#else
ELSEIF(KFA.EQ.111.OR.KFA.EQ.221.OR.KFA.EQ.331) THEN
IF (KFA.EQ.111) THEN
KFL(2) = 1
KFL(3) = 1
ENDIF
IF (KFA.EQ.221) THEN
KFL(2) = 2
KFL(3) = 2
ENDIF
IF (KFA.EQ.331) THEN
KFL(2) = 3
KFL(3) = 3
ENDIF
#endif
ELSEIF(KFA.EQ.223.AND.PYR(0).GT.0.5D0) THEN
KFL(2)=1
KFL(3)=1
......
......@@ -188,8 +188,13 @@ C...this is usually the case!
PARU12=4D0*PARU12
PARU13=2D0*PARU13
GOTO 140
#ifndef FOR_CORSIKA
ELSEIF(NTRY.GT.100.OR.NTRYR.GT.100) THEN
CALL PYERRM(14,'(PYSTRF:) caught in infinite loop')
#else
ELSEIF(NTRY.GT.500.OR.NTRYR.GT.500) THEN
CALL PYERRM( 4,'(PYSTRF:) caught in infinite loop')
#endif
IF(MSTU(21).EQ.2) MSTU(90)=0
IF(MSTU(21).GE.1) RETURN
ENDIF
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment