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/ ...@@ -239,7 +239,11 @@ C common /DTVDMP/
C common /DTGLGP/ C common /DTGLGP/
JSTatb = 1000 JSTatb = 1000
JBInsb = 49 JBInsb = 49
#ifndef FOR_CORSIKA
CGLb = ' ' CGLb = ' '
#else
cdh do not overwrite the glauber data set name of corsika
#endif
IF ( ITRspt.EQ.1 ) THEN IF ( ITRspt.EQ.1 ) THEN
IOGlb = 100 IOGlb = 100
ELSE ELSE
......
...@@ -227,6 +227,10 @@ C LEPTO: pick out one struck nucleon ...@@ -227,6 +227,10 @@ C LEPTO: pick out one struck nucleon
B = ZERO B = ZERO
GOTO 300 GOTO 300
END IF END IF
#ifdef FOR_CORSIKA
if (LPRI.GT.4) write(LOUT,*)'DT_DIAGR: before loop 4'
#endif
DO ina = 1 , Na DO ina = 1 , Na
C cross section fluctuations C cross section fluctuations
...@@ -347,5 +351,9 @@ C supress Glauber-cascade by direct photon processes ...@@ -347,5 +351,9 @@ C supress Glauber-cascade by direct photon processes
nwa(Inta) = nwa(Inta) + 1 nwa(Inta) = nwa(Inta) + 1
nwb(Intb) = nwb(Intb) + 1 nwb(Intb) = nwb(Intb) + 1
END IF END IF
#ifdef FOR_CORSIKA
if (LPRI.GT.4) write(LOUT,*)'DT_DIAGR: at end'
#endif
END SUBROUTINE END SUBROUTINE
...@@ -24,7 +24,10 @@ C*********************************************************************** ...@@ -24,7 +24,10 @@ C***********************************************************************
INTEGER i , id , idchk , IDT_IPDGHA , idum , idxmor , iflg , INTEGER i , id , idchk , IDT_IPDGHA , idum , idxmor , iflg ,
& ifrg , ih1 , ih2 , ihismo , ii , ij , ijk , ijoin , & ifrg , ih1 , ih2 , ihismo , ii , ij , ijk , ijoin ,
& iniemc , ip , ipje , Irej & 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 , & isjoin , ismor , istsrg , iststg , jdaug , k1 , k2 ,
& kfmor , kk , Kmode & kfmor , kk , Kmode
INTEGER mo , mode , MXJOIN , naccep , nend , Nfrg , nlines , INTEGER mo , mode , MXJOIN , naccep , nend , Nfrg , nlines ,
...@@ -71,11 +74,17 @@ C jetset ...@@ -71,11 +74,17 @@ C jetset
LOGICAL LDBgpr LOGICAL LDBgpr
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,*) WRITE (77,*)
WRITE (77,'(A,5I6)') ' EVTFRG IN:' , Kmode , Nfrg , Npymem , WRITE (77,'(A,5I6)') ' EVTFRG IN:' , Kmode , Nfrg , Npymem ,
& Irej , NHKk & Irej , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') 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 END IF
mode = Kmode mode = Kmode
iststg = 7 iststg = 7
...@@ -97,10 +106,15 @@ C & ((NOBAM(I).NE.0).AND.(MODE.EQ.2)) ...@@ -97,10 +106,15 @@ C & ((NOBAM(I).NE.0).AND.(MODE.EQ.2))
C pick up chains from dtevt1 C pick up chains from dtevt1
idchk = IDHkk(i)/10000 idchk = IDHkk(i)/10000
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,6I6)') ' EVTFRG LACCEP:' , i , NPOint(3) , WRITE (77,'(A,6I6)') ' EVTFRG LACCEP:' , i , NPOint(3) ,
& NPOint(4) , idchk , istsrg , NHKk & NPOint(4) , idchk , istsrg , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') 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 END IF
IF ( (idchk.EQ.iststg) .AND. laccep ) THEN IF ( (idchk.EQ.iststg) .AND. laccep ) THEN
IF ( idchk.EQ.7 ) THEN IF ( idchk.EQ.7 ) THEN
...@@ -123,10 +137,15 @@ C & ICCHAI(2,IDCH(I)) = ICCHAI(2,IDCH(I))+1 ...@@ -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 IF (IDRES(I).NE.0) ICRES(IDCH(I)) = ICRES(IDCH(I))+1
C special treatment for small chains already corrected to hadrons C special treatment for small chains already corrected to hadrons
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,4I6)') ' EVTFRG NO GOTO 16:' , IDRes(i) , WRITE (77,'(A,4I6)') ' EVTFRG NO GOTO 16:' , IDRes(i) ,
& ifrg , Nfrg , NHKk & ifrg , Nfrg , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') 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 END IF
IF ( IDRes(i).NE.0 ) THEN IF ( IDRes(i).NE.0 ) THEN
IF ( IDRes(i).EQ.11 ) THEN IF ( IDRes(i).EQ.11 ) THEN
...@@ -138,11 +157,17 @@ C special treatment for small chains already corrected to hadrons ...@@ -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) CALL DT_EVTEMC(PHKk(1,i),PHKk(2,i),PHKk(3,i),PHKk(4,i)
& ,iniemc,idum,idum) & ,iniemc,idum,idum)
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,4I6,/,1P,4G23.15)') WRITE (77,'(A,4I6,/,1P,4G23.15)')
& ' EVTFRG EVTEMC:' , i , IDHkk(i) , iniemc , & ' EVTFRG EVTEMC:' , i , IDHkk(i) , iniemc ,
& NHKk , (PHKk(ijk,i),ijk=1,4) & NHKk , (PHKk(ijk,i),ijk=1,4)
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') 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 END IF
iniemc = 2 iniemc = 2
END IF END IF
...@@ -176,18 +201,29 @@ C special treatment for small chains already corrected to hadrons ...@@ -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), CALL DT_EVTEMC(PHKk(1,kk),PHKk(2,kk),PHKk(3,kk),
& PHKk(4,kk),iniemc,idum,idum) & PHKk(4,kk),iniemc,idum,idum)
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,4I6,/,1P,4G23.15)') WRITE (77,'(A,4I6,/,1P,4G23.15)')
& ' EVTFRG EVTEMC-2:' , kk , IDHkk(kk) , & ' EVTFRG EVTEMC-2:' , kk , IDHkk(kk) ,
& iniemc , NHKk , (PHKk(ijk,kk),ijk=1,4) & iniemc , NHKk , (PHKk(ijk,kk),ijk=1,4)
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') 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 END IF
CALL DT_EVTFLC(IDHkk(kk),1,iniemc,idum,idum) CALL DT_EVTFLC(IDHkk(kk),1,iniemc,idum,idum)
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,4I6)') ' EVTFRG EVTFLC:' , kk , WRITE (77,'(A,4I6)') ' EVTFRG EVTFLC:' , kk ,
& IDHkk(kk) , iniemc , NHKk & IDHkk(kk) , iniemc , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2 WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,4I6)')
& ' DT_EVTFRG EVTFLC:',KK,IDHKK(KK),INIEMC,NHKK
#endif
END IF END IF
iniemc = 2 iniemc = 2
END IF END IF
...@@ -244,9 +280,14 @@ C join the two-parton system ...@@ -244,9 +280,14 @@ C join the two-parton system
CALL PYJOIN(ij,ijoin) CALL PYJOIN(ij,ijoin)
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6)') ' EVTFRG PYJOIN:' , ij , NHKk WRITE (77,'(A,2I6)') ' EVTFRG PYJOIN:' , ij , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2 WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6)')
& ' EVTFRG PYJOIN:',IJ,NHKK
#endif
END IF END IF
END IF END IF
IDHkk(i) = 99999 IDHkk(i) = 99999
...@@ -281,10 +322,15 @@ C final state parton shower ...@@ -281,10 +322,15 @@ C final state parton shower
rqlun = MIN(pt1,pt2) rqlun = MIN(pt1,pt2)
CALL PYSHOW(ih1,ih2,rqlun) CALL PYSHOW(ih1,ih2,rqlun)
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6,1P,G23.15)') WRITE (77,'(A,2I6,1P,G23.15)')
& ' EVTFRG PYSHOW:' , ih1 , ih2 , rqlun & ' EVTFRG PYSHOW:' , ih1 , ih2 , rqlun
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2 WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6,1P,G23.15)')
& ' EVTFRG PYSHOW:',IH1,IH2,RQLUN
#endif
END IF END IF
isjoin(k1) = 0 isjoin(k1) = 0
...@@ -304,17 +350,27 @@ C final state parton shower ...@@ -304,17 +350,27 @@ C final state parton shower
CALL DT_INITJS(mode) CALL DT_INITJS(mode)
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6)') ' EVTFRG INITJS:' , mode , NHKk WRITE (77,'(A,2I6)') ' EVTFRG INITJS:' , mode , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2 WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6)')
& ' EVTFRG INITJS:',MODE,NHKK
#endif
END IF END IF
C hadronization C hadronization
CALL PYEXEC CALL PYEXEC
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6)') ' EVTFRG PYEXEC:' , MSTu(24) , NHKk WRITE (77,'(A,2I6)') ' EVTFRG PYEXEC:' , MSTu(24) , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2 WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6)')
& ' EVTFRG PYEXEC:',MSTU(24),NHKK
#endif
END IF END IF
IF ( MSTu(24).NE.0 ) THEN IF ( MSTu(24).NE.0 ) THEN
...@@ -411,9 +467,14 @@ C there was no mother resonance ...@@ -411,9 +467,14 @@ C there was no mother resonance
END IF END IF
END DO END DO
IF ( LDBgpr ) THEN IF ( LDBgpr ) THEN
#ifndef FOR_CORSIKA
WRITE (77,'(A,2I6)') ' EVTFRG 13:' , nlines , NHKk WRITE (77,'(A,2I6)') ' EVTFRG 13:' , nlines , NHKk
CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2) CALL FLRNOC(isdrn1,isdrn2,iseed1,iseed2)
WRITE (77,'(2X,2Z8)') iseed1 , iseed2 WRITE (77,'(2X,2Z8)') iseed1 , iseed2
#else
WRITE (LOUT,'(A,2I6)')
& ' EVTFRG 13:',NLINES,NHKK
#endif
END IF END IF
IF ( LEMcck ) THEN IF ( LEMcck ) THEN
chklev = TINY1 chklev = TINY1
......
...@@ -439,8 +439,12 @@ C put residual nuclei into DTEVT1 ...@@ -439,8 +439,12 @@ C put residual nuclei into DTEVT1
C the following patch is required to transmit the correct excitation C the following patch is required to transmit the correct excitation
C energy to Eventd C energy to Eventd
IF ( ITRspt.EQ.1 ) THEN IF ( ITRspt.EQ.1 ) THEN
IF ( ABS(amrcl(i)-AMRcl0(i)-EEXc(i)).GT.1.D-04 ) IF ( ABS(amrcl(i)-AMRcl0(i)-EEXc(i)).GT.1.D-04 )
& WRITE (77,*) #ifndef FOR_CORSIKA
& WRITE (77,*)
#else
& WRITE (LOUT,*)
#endif
& ' DT_FICONF:AMRCL(I),AMRCL0(I),EEXC(I)' , & ' DT_FICONF:AMRCL(I),AMRCL0(I),EEXC(I)' ,
& amrcl(i) , AMRcl0(i) , EEXc(i) & amrcl(i) , AMRcl0(i) , EEXc(i)
prcl0 = prcl(i,4) prcl0 = prcl(i,4)
......
...@@ -54,6 +54,9 @@ C get actual energy from /DTLTRA/ ...@@ -54,6 +54,9 @@ C get actual energy from /DTLTRA/
ECMnow = UMO ECMnow = UMO
Q2 = VIRt Q2 = VIRt
C 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 C new patch for pre-initialized variable projectile/target/energy runs
IF ( IOGlb.NE.100 ) THEN IF ( IOGlb.NE.100 ) THEN
i1 = 1 i1 = 1
......
...@@ -29,6 +29,13 @@ C emulsion treatment ...@@ -29,6 +29,13 @@ C emulsion treatment
INCLUDE 'inc/dtcomp' INCLUDE 'inc/dtcomp'
C Glauber formalism: flags and parameters for statistics C Glauber formalism: flags and parameters for statistics
INCLUDE 'inc/dtglgp' 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 number of data sets other than protons and nuclei
C at the moment = 2 (pions and kaons) C at the moment = 2 (pions and kaons)
PARAMETER (MAXOFF=2) PARAMETER (MAXOFF=2)
...@@ -87,7 +94,13 @@ C open Glauber-data output file ...@@ -87,7 +94,13 @@ C open Glauber-data output file
idx = INDEX(CGLb,' ') idx = INDEX(CGLb,' ')
k = 8 k = 8
IF ( idx.GT.1 ) k = idx - 1 IF ( idx.GT.1 ) k = idx - 1
#ifndef FOR_CORSIKA
OPEN (LDAt,FILE=CGLb(1:k)//'.glb',STATUS='UNKNOWN') 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-------------------------------------------------------------------------- C--------------------------------------------------------------------------
C Glauber-initialization for proton and nuclei projectiles C Glauber-initialization for proton and nuclei projectiles
......
...@@ -37,7 +37,14 @@ C Glauber formalism: parameters ...@@ -37,7 +37,14 @@ C Glauber formalism: parameters
INCLUDE 'inc/dtglam' INCLUDE 'inc/dtglam'
C Glauber formalism: cross sections C Glauber formalism: cross sections
INCLUDE 'inc/dtglxs' INCLUDE 'inc/dtglxs'
C number of data sets other than protons and nuclei
#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) C at the moment = 2 (pions and kaons)
PARAMETER (MAXOFF=2) PARAMETER (MAXOFF=2)
DIMENSION ijpini(5) , ioffst(25) DIMENSION ijpini(5) , ioffst(25)
...@@ -84,11 +91,21 @@ C ...@@ -84,11 +91,21 @@ C
idx = INDEX(CGLb,' ') idx = INDEX(CGLb,' ')
k = 12 k = 12
IF ( idx.GT.1 ) k = idx - 1 IF ( idx.GT.1 ) k = idx - 1
#ifndef FOR_CORSIKA
OPEN (LDAt,FILE=CGLb(1:k)//'.glb',STATUS='UNKNOWN') OPEN (LDAt,FILE=CGLb(1:k)//'.glb',STATUS='UNKNOWN')
IF ( LPRi.GT.4 ) WRITE (LOUt,99010) CGLb(1:k)//'.glb' IF ( LPRi.GT.4 ) WRITE (LOUt,99010) CGLb(1:k)//'.glb'
99010 FORMAT (/,' GLBSET: impact parameter distributions read from ', 99010 FORMAT (/,' GLBSET: impact parameter distributions read from ',
& 'file ',A12,/) & '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
C read binning information C read binning information
READ (LDAt,'(I4,2X,2E13.5)') nebin , elo , ehi READ (LDAt,'(I4,2X,2E13.5)') nebin , elo , ehi
......
...@@ -14,7 +14,7 @@ C*********************************************************************** ...@@ -14,7 +14,7 @@ C***********************************************************************
DOUBLE PRECISION xlim2 , xlim3 , xmod , xseaco , ZERO DOUBLE PRECISION xlim2 , xlim3 , xmod , xseaco , ZERO
INTEGER i , ibin , ichain , icw , idip , idit , Idp , idt , idum , INTEGER i , ibin , ichain , icw , idip , idit , Idp , idt , idum ,
& idum1 , ifirst , Iglau , ihdum , ihshma , ii , iip , iit , & idum1 , ifirst , Iglau , ihdum , ihshma , ii , iip , iit ,
& inseed , iplow , ippn & iplow , ippn
INTEGER iprang , iratio , irej1 , itlow , iwhat , INTEGER iprang , iratio , irej1 , itlow , iwhat ,
& iwhat1 , iwhat2 , ixsqel , j , & iwhat1 , iwhat2 , ixsqel , j ,
& k , kc , kframe , MXCARD , na1 , na2 & k , kc , kframe , MXCARD , na1 , na2
...@@ -23,7 +23,7 @@ C*********************************************************************** ...@@ -23,7 +23,7 @@ C***********************************************************************
#ifdef FOR_FLUKA #ifdef FOR_FLUKA
INTEGER iseed1 , iseed2 , isrnd1 , isrnd2 INTEGER inseed , iseed1 , iseed2 , isrnd1 , isrnd2
#endif #endif
SAVE SAVE
...@@ -196,6 +196,47 @@ C in this case Epn is expected to carry the beam momentum ...@@ -196,6 +196,47 @@ C in this case Epn is expected to carry the beam momentum
lext = .TRUE. lext = .TRUE.
GOTO 300 GOTO 300
END IF 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 #else
IF ( Ncases.EQ.-1 ) THEN IF ( Ncases.EQ.-1 ) THEN
IP = Npmass IP = Npmass
...@@ -217,6 +258,7 @@ C in this case Epn is expected to carry the beam momentum ...@@ -217,6 +258,7 @@ C in this case Epn is expected to carry the beam momentum
GOTO 300 GOTO 300
END IF END IF
#endif #endif
#endif
C read control card from input-unit LINP C read control card from input-unit LINP
READ (LINp,'(A78)',END=400) cline READ (LINp,'(A78)',END=400) cline
IF ( cline(1:1).EQ.'*' ) THEN IF ( cline(1:1).EQ.'*' ) THEN
......
...@@ -78,6 +78,12 @@ C VDM parameter for photon-nucleus interactions ...@@ -78,6 +78,12 @@ C VDM parameter for photon-nucleus interactions
C parameters for hA-diffraction C parameters for hA-diffraction
INCLUDE 'inc/dtdiha' 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) , COMPLEX*16 pp11(MAXNCL) , pp12(MAXNCL) , pp21(MAXNCL) ,
& pp22(MAXNCL) , ompp11 , ompp12 , ompp21 , ompp22 , & pp22(MAXNCL) , ompp11 , ompp12 , ompp21 , ompp22 ,
& dipp11 , dipp12 , dipp21 , dipp22 , avdipp , pptmp1 , & dipp11 , dipp12 , dipp21 , dipp22 , avdipp , pptmp1 ,
...@@ -106,10 +112,22 @@ C not needed for these interactions.. ...@@ -106,10 +112,22 @@ C not needed for these interactions..
i = INDEX(CGLb,' ') i = INDEX(CGLb,' ')
IF ( i.EQ.0 ) THEN IF ( i.EQ.0 ) THEN
cfile = CGLb//'.glb' cfile = CGLb//'.glb'
#ifndef FOR_CORSIKA
OPEN (LDAt,FILE=CGLb//'.glb',STATUS='UNKNOWN') 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 ELSE IF ( i.GT.1 ) THEN
cfile = CGLb(1:i-1)//'.glb' cfile = CGLb(1:i-1)//'.glb'