IAP GITLAB
Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
C
CRMC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Air Shower Physics
CRMC
Commits
2f1a425e
Commit
2f1a425e
authored
Nov 30, 2020
by
Tanguy Pierog
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add modifications in interface. Now running.
parent
6ee7c4b6
Changes
15
Hide whitespace changes
Inline
Side-by-side
Showing
15 changed files
with
226 additions
and
11 deletions
+226
-11
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_DEFAUL.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_DEFAUL.f
+4
-0
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_DIAGR.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_DIAGR.f
+8
-0
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_EVTFRG.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_EVTFRG.f
+62
-1
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_FICONF.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_FICONF.f
+6
-2
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_GLAUBE.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_GLAUBE.f
+3
-0
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_GLBINI.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_GLBINI.f
+13
-0
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_GLBSET.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_GLBSET.f
+19
-2
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_INIT.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_INIT.f
+44
-2
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_XSGLAU.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_XSGLAU.f
+18
-0
src/dpmjet/3.2019-1/DPMJET-19.1/src/phojet/PHO_DATINI.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/phojet/PHO_DATINI.f
+11
-3
src/dpmjet/3.2019-1/DPMJET-19.1/src/phojet/PHO_GETPDF.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/phojet/PHO_GETPDF.f
+1
-1
src/dpmjet/3.2019-1/DPMJET-19.1/src/phojet/PHO_SETPCOMB.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/phojet/PHO_SETPCOMB.f
+12
-0
src/dpmjet/3.2019-1/DPMJET-19.1/src/pythia/pypdfu.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/pythia/pypdfu.f
+4
-0
src/dpmjet/3.2019-1/DPMJET-19.1/src/pythia/pyspli.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/pythia/pyspli.f
+16
-0
src/dpmjet/3.2019-1/DPMJET-19.1/src/pythia/pystrf.f
src/dpmjet/3.2019-1/DPMJET-19.1/src/pythia/pystrf.f
+5
-0
No files found.
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_DEFAUL.f
View file @
2f1a425e
...
...
@@ -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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_DIAGR.f
View file @
2f1a425e
...
...
@@ -227,6 +227,10 @@ C LEPTO: pick out one struck nucleon
B
=
ZERO
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
...
...
@@ -347,5 +351,9 @@ C supress Glauber-cascade by direct photon processes
nwa
(
Inta
)
=
nwa
(
Inta
)
+
1
nwb
(
Intb
)
=
nwb
(
Intb
)
+
1
END
IF
#ifdef FOR_CORSIKA
if
(
LPRI
.GT.
4
)
write
(
LOUT
,
*
)
'DT_DIAGR: at end'
#endif
END
SUBROUTINE
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_EVTFRG.f
View file @
2f1a425e
...
...
@@ -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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_FICONF.f
View file @
2f1a425e
...
...
@@ -439,8 +439,12 @@ C put residual nuclei into DTEVT1
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
)
&
WRITE
(
77
,
*
)
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
)
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_GLAUBE.f
View file @
2f1a425e
...
...
@@ -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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_GLBINI.f
View file @
2f1a425e
...
...
@@ -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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_GLBSET.f
View file @
2f1a425e
...
...
@@ -37,7 +37,14 @@ C Glauber formalism: parameters
INCLUDE
'inc/dtglam'
C
Glauber
formalism
:
cross
sections
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
)
PARAMETER
(
MAXOFF
=
2
)
DIMENSION
ijpini
(
5
)
,
ioffst
(
25
)
...
...
@@ -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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_INIT.f
View file @
2f1a425e
...
...
@@ -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
,
&
i
nseed
,
i
plow
,
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
i
nseed
,
i
seed1
,
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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/dpmjet/DT_XSGLAU.f
View file @
2f1a425e
...
...
@@ -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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/phojet/PHO_DATINI.f
View file @
2f1a425e
...
...
@@ -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
/
...
...
@@ -527,11 +530,16 @@ C max. iteration number in PHO_SELSX2
C
max
.
iteration
number
in
PHO_SELSXI
IPAmdl
(
183
)
=
50
C
Default
directory
for
data
files
C
Default
directory
for
data
files
#ifndef FOR_CORSIKA
IF
(
LENdir
.EQ.
0
)
THEN
DATDir
=
'dpmdata/'
LENDir
=
8
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'
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/phojet/PHO_GETPDF.f
View file @
2f1a425e
...
...
@@ -36,7 +36,7 @@ C PHOPDF version 2.0 common
C
currently
activated
parton
density
parametrizations
INCLUDE
'inc/poppdf'
LOGICAL
ct14init
(
3
)
DATA
ct14init
/
.FALSE.
,
.FALSE.
,
.FALSE.
/
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/phojet/PHO_SETPCOMB.f
View file @
2f1a425e
...
...
@@ -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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/pythia/pypdfu.f
View file @
2f1a425e
...
...
@@ -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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/pythia/pyspli.f
View file @
2f1a425e
...
...
@@ -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
...
...
src/dpmjet/3.2019-1/DPMJET-19.1/src/pythia/pystrf.f
View file @
2f1a425e
...
...
@@ -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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment