File indexing completed on 2024-04-06 12:14:00
0001
0002
0003 subroutine aaset(iop)
0004
0005
0006
0007
0008 include 'epos.inc'
0009 include 'epos.incpar'
0010 include 'epos.incsem'
0011 common/record/maxrec(2),irecty(30,2)
0012 common/cfacmss/facmss /cr3pomi/r3pomi,r4pomi/cifset/ifset
0013 common /ems12/iodiba,bidiba ! defaut iodiba=0. if iodiba=1, study H-Dibaryon
0014 character*500 fndat,fnncs,fnIIdat,fnIIncs !qgs-II????????
0015 common/qgsfname/ fndat, fnncs, ifdat, ifncs
0016 common/qgsIIfname/fnIIdat, fnIIncs, ifIIdat, ifIIncs !qgs-II????????
0017 common/ghecsquel/anquasiel,iquasiel
0018 common/cbincond/nozero,ibmin,ibmax
0019 common/photrans/phoele(4),ebeam
0020 common/producetab/ producetables !used to link CRMC
0021 logical producetables !with EPOS and QII
0022 !gauss weights
0023 data (tgss(2,i),i=1,7)/ .3399810436,.8611363116 ,5*0. /
0024 data (wgss(2,i),i=1,7)/ .6521451549,.3478548451 ,5*0. /
0025 data (tgss(3,i),i=1,7)/ .2386192,.6612094,.9324700 ,4*0. /
0026 data (wgss(3,i),i=1,7)/ .4679139,.3607616,.1713245 ,4*0. /
0027 data (tgss(5,i),i=1,7)/ .1488743389,.4333953941,.6794095682
0028 * ,.8650633666,.9739065285 ,2*0. /
0029 data (wgss(5,i),i=1,7)/ .2955242247,.2692667193,.2190863625
0030 * ,.1494513491,.0666713443 ,2*0. /
0031 data (tgss(7,i),i=1,7)/ .9862838,.9284349,.8272013,.6872929
0032 * ,.5152486,.3191124,.1080549 /
0033 data (wgss(7,i),i=1,7)/ .03511946,.08015809,.1215186,.1572032
0034 * ,.1855384,.2051985,.2152639 /
0035
0036 if(iop.eq.1)write(ifmt,'(a)')'default settings ...'
0037 if(iop.eq.1)goto 1001
0038 if(iop.eq.2)goto 1002
0039
0040
0041
0042 iversn=int(1.99*100) !version number
0043 iverso=int(1.99*100) !last official version
0044
0045
0046
0047 iappl=1 !choice for application (0,1,2,3,4,5,6,7,8,9,10)
0048
0049
0050
0051 model=1
0052 iquasiel=1 !allow (1) or not (0) quasi-elastic event in model 3
0053
0054
0055
0056 fnnx='path/epos ' !path epos name
0057 fnch='zzz.check ' !check-file name
0058 fnhi='zzz.histo ' !histo-file name
0059 fndt='zzz.data ' !data-file name
0060 fncp='zzz.copy ' !copy-file name
0061 fnii='zzz.initl ' !initl-file name
0062 fnid='zzz.inidi ' !inidi-file name
0063 fndr='zzz.inidr ' !inidr-file name
0064 fnie='zzz.iniev ' !iniev-file name
0065 fnrj='zzz.inirj ' !inirj-file name
0066 fncs='zzz.inics ' !inics-file name
0067 nfnnx=index(fnnx,' ')-1 !length of path epos name
0068 nfnch=index(fnch,' ')-1 !length of check-file name
0069 nfnhi=index(fnhi,' ')-1 !length of histo-file name
0070 nfndt=index(fndt,' ')-1 !length of data-file name
0071 nfncp=index(fncp,' ')-1 !length of copy-file name
0072 nfnii=index(fnii,' ')-1 !length of initl-file name
0073 nfnid=index(fnid,' ')-1 !length of inidi-file name
0074 nfndr=index(fndr,' ')-1 !length of inidr-file name
0075 nfnie=index(fnie,' ')-1 !length of iniev-file name
0076 nfnrj=index(fnrj,' ')-1 !length of inirj-file name
0077 nfncs=index(fncs,' ')-1 !length of inics-file name
0078
0079 ifop=5 !optns-file unit
0080 ifmt=6 !std output unit
0081 ifcx=31 !check-file unit (for open)
0082 ifch=31 !check-file unit (for write)
0083 ifhi=35 !histo-file unit
0084 ifdt=51 !data-file unit
0085 ifcp=52 !copy-file unit
0086 ifin=53 !input-file unit
0087
0088 hydt='---'
0089
0090 producetables=.true.
0091
0092
0093
0094
0095 iseqini=2 !sequence number at start program
0096
0097 seedi=0d0 !.ne.0.
0098 iseqsim=1 !.ne.iseqini : sequence number at start program
0099
0100 seedj=0d0 !.ne.0.
0101
0102 seedj2=0d0
0103 call ranfini(0d0,0,-1) !initialize some parameters
0104
0105
0106 1001 continue ! ----> entry iop=1 <-----
0107
0108 call factoriel
0109
0110
0111
0112
0113 nevent=1 !number of events
0114 nfull=-1 !number of full events (ico+hydro+f.o.)(if different from -1)
0115 nfreeze=1 !number of freeze out events per epos event
0116 ninicon=1 ! +-number of events per initial condition
0117 ! if positive: keep same b, otherwise generate b each time
0118 engy=-1 !energy
0119 elab=-1 !energy lab
0120 ecms=-1 !energy centre of mass
0121 ekin=-1 !energy kinetic
0122 pnll=-1 !momentum
0123 ebeam=-1 !beam energy for proton in fake DIS (pi0-proton collision)
0124 egymin=6. !minimum energy
0125 egymax=2.E+06 !maximum energy
0126 noebin=1 !number of energy bins
0127 engmin=0 !minimum energy
0128 engmax=0 !maximum energy
0129 iologe=-1 !0=linear bins 1=log bins (cms engy)
0130 iologl=-1 !0=linear bins 1=log bins (Kinetic engy)
0131 infragm=0 !nuclear fragmentation
0132
0133
0134
0135 if(iop.eq.0)iprmpt=-2 !prompt (>0) or not (<0)
0136 ish=0 !1,2,3,4 ...: more and more detailed messages
0137 irandm=0 !prints all random numbers (1)
0138 irewch=0 !rewinds check file before each event (1)
0139 if(iop.eq.0)iecho=1 !verify option for input reading
0140 modsho=1 !message all modsho events
0141 idensi=0 !must be 1 when subr xjden1 is used
0142 ishevt=0 !minimum event number for certain print options
0143 iwseed=1 !print out seed (1) or not
0144 jwseed=1 !print out seed in see file (1) or not
0145
0146
0147
0148 fkappa=0.0145 !String tension (GeV2)
0149 fkappag=0.0145 !String tension (GeV2) for gluon string
0150 fkainc=0.35 !factor for natural increase of string tension with energy
0151
0152
0153 fkamax=1.e30 !limit of effect in hadronic collision on fkappa
0154 pud=0.433 !prob u d (from e+e- but used only in epos-dky/vedi)
0155 pudd=0.88 !d suppression in diquark break (e+e- data)
0156 puds=0.50 !s suppression in diquark break (important for Xi production in e+e- AND aXi in NA49)
0157 pudc=0.33 !c suppression in diquark break (??? no data)
0158 pmqu=0.003 !mass quark u for string fragm
0159 pmqd=0.004 !mass quark d for string fragm
0160 pmqs=0.077 !mass quark s for string fragm
0161 pmqc=0.14 !mass quark c for string fragm (real mass 1.15<m<1.35)
0162 pmqq=0.1185 !mass diquark for string fragm (fix number of baryons)
0163 strcut=1. !cut factor for diffractive string fragmentation (1=no suppresion)
0164 diqcut=0.5 !baryon cut factor for diffractive string fragmentation (needed for pi+p->p/ap data (pz/E > diqcut : no diquark for first node)
0165 pdiqua= 0.1 !qq-qqbar probability in epos-dro/vedi (decazys only)
0166 ptfra= 0.35 !string break pt
0167 ptfraqq=0.35 !string end break pt
0168 ptfrasr=0. !string break pt increase for strangeness (disable in epos-fra)
0169 pbreak=-0.33 !break-parameter (~0.4 to match NA49 data and pi0 spectra for CR)
0170
0171 pbreakg=0. !minimum pbreak at high energy in e+e- parameterization
0172 zetacut=0. !g->ggq2 cut for special hadronization
0173
0174
0175
0176 ndecay=0 !ndecay suppresses certain resonance decays
0177 !0000001: all resonance decays suppressed
0178 !0000010: k_short/long (+-20) decays suppressed
0179 !0000100: lambda (+-2130) decays suppressed
0180 !0001000: sigma (+-1130,+-2230) decays suppressed
0181 !0010000: cascade (+-2330,+-1330) decays suppressed
0182 !0100000: omega (+-3331) decays suppressed
0183 !1000000: pi0 (110) decays suppressed
0184 !also several "1"s may be used with obvious meaning
0185 maxres=99999 !maximum resonance spin
0186 aouni=0. !technical parameter for development
0187
0188
0189
0190 iolept=1 !q2-x ditribution calculated (1) or taken from table (<0)
0191 ydmin=0 ! range of y
0192 ydmax=0
0193 qdmin=0 ! range of q**2
0194 qdmax=0
0195 themin=0 !minimum scattering angle
0196 themax=0 !maximum scattering angle
0197 elomin=0 !minimum energy of outgoing lepton
0198 elepti=0 !incoming lepton energy
0199 elepto=0 !outgoing lepton energy
0200 angmue=3.9645/360.*2*3.14159 !mue angle
0201 icinpu=0
0202 itflav=0 ! initial flavor for e+e-
0203 idisco=0 !deep inelastic contributions
0204 !0=all, 1=direct-light, 2=direct-charm, 3=resolved
0205
0206
0207
0208 isetcs=3 !option to obtain pomeron parameters
0209 ! 0.....determine parameters but do not use Kfit
0210 ! 1.....determine parameters and use Kfit
0211 ! else..get from table
0212 ! should be sufficiently detailed
0213 ! say iclegy1=1,iclegy2=99
0214 ! table is always done, more or less detailed!!!
0215 !and option to use cross ection tables
0216 ! 2....tabulation of formula
0217 ! 3....tabulation of simulations
0218 ! else...not
0219 iclegy1=1 !energy class lower limit ( 1 minimal 1 realistic )
0220 iclegy2=99 !energy class upper limit ( 1 option 99 use of table )
0221 isigma=0 !option for xsection printing (always calculated now)
0222 ! 0=no, 1=yes : calculation (not good for ionudi=2)
0223 ! 2=AA pseudo simulations
0224
0225
0226
0227 idprojin=1120 !projectile particle id
0228 idtargin=1120 !target particle id
0229 idproj=1120 !projectile particle id
0230 idtarg=1120 !target particle id
0231 iregge=0 !consider reggeons (1=yes 0=no)
0232 isopom=1 !consider soft pomerons (1=yes 0=no)
0233 ishpom=1 !consider semihard pomerons (1=yes 0=no)
0234 iscreen=1 !consider screening corrections (1=yes 0=no)
0235 isplit=1 !consider splitting corrections (1=yes 0=no)
0236 irzptn=0 !recalculate Zptn (1=yes 0=no) ????????maybe obsolete??????????
0237 irmdrop=1 !consider droplet for remnants (1=yes 0=no)
0238 nprmax=10000 !maximum number of pomerons/reggeons
0239 iemspl=0
0240 intpol=3 !number of points for interpolation in psfli, psfaz
0241 ioems=2
0242 iomega=1 !option for omega calculation (if 2, no diffraction in G)
0243 !hadron excitation classes (used in psvin)
0244 icdp=2 !projectile hadron excitation
0245 icdt=2 !target hadron excitation
0246 !hadron classes: 1=pions,2=nucleons,3=kaons
0247 iclpro1=1 !projectile hadron class lower limit
0248 iclpro2=3 !projectile hadron class upper limit
0249 icltar1=2 !target hadron class lower limit (should not be change (see epos-sem))
0250 icltar2=2 !target hadron class upper limit (should not be change (see epos-sem))
0251 egylow=1.5 !lower limit of lowest energy bin
0252 delh=0.25 !effective overcriticity for the hard pom (techn param)
0253 factgam=1 !enhancement factor for gammas
0254
0255
0256
0257 alpfomi= 0. !normalization of function fom for Phi^n (z0=alpfomi)
0258 betfom= 5.d0 !slope of function fom for Phi^n
0259 gamfom= 3.5d0 !Z slope of function fom for Phi^n
0260 betpom= 0.25 !gluon structure function parameter for the so
0261 glusea= 0.1 !sea quarks / (sea quarks + gluons) at x -> 0
0262 r2had(2)= 1.2 !r2 proton
0263 r2hads(2)= 1.25 !diff corr factor proton
0264 slopom= 0.06 !alpha prime pomeron
0265 slopoms= 0.2 !alpha prime pomeron dif
0266 gamhad(2)= 1. !gamma proton increase-> sig up, n up, softPom up
0267 gamhadsi(2)=-1. !correction factor to gamma soft proton (<0 = 1 = same as gamhad)
0268 gamtil= 0.08 !increase -> sig up, n up, hard Pom up
0269 alppar= 0.55 !alpha particip (not 1 !) increase -> sig up, n down, width y down
0270 alppom= 1.075 !alpha pomeron
0271 ptsend= 1. !string end pt
0272 ptsendi= 0.3 !string end pt for non excited state and diquark
0273 ptsems= 0.2 !mass of string end (minimum pt)
0274 ptsecu= 1. !cut factor for gaussian distribution
0275 ptdiff= 0.32 !pt for diffraction
0276 q2min= 4.0 !q**2 cutoff
0277 q2ini= 0.25 !resolution scale
0278 q2fin= 0.02 !q**2 cutoff timelike decrease -> high pt down
0279 amdrmax= 30. !maximum mass leading droplet (<50 for stability)
0280 amdrmin= 10. !minimum mass leading droplet
0281 facdif= 0.4 !factor for diffractive profile
0282 facmc= 1.05 !correction factor to match MC simulations (should be 1.)
0283 reminv= 0.17 !remnant inversion probability (inversion important for forward pi(0) spectra : consequences on Xmax)
0284 edmaxi= 1.e12 !defines edmax in epos-sem
0285 epmaxi= 1.e12 !defines epmax in epos-sem
0286
0287
0288
0289 qcdlam=.04 !lambda_qcd squared
0290 naflav=3 !number of active flavors (hard string)
0291 nrflav=3 !number of active flavors in remnant and string fragm
0292 !nrflav is defined later as max(nrflav,naflav)
0293 factk=2. !k-factor value
0294 alfe=1./137.
0295 pt2cut=0. !p_t-cutoff for the born process
0296 rstrau(1)=1. !pion !effective ratio of u sea over u sea basis
0297 rstrad(1)=1. !effective ratio of d sea over u sea basis
0298 rstras(1)=0.2 !effective ratio of s sea over u sea basis (kaons in pipp250)
0299 rstrac(1)=1. !effective ratio of c sea over u sea basis
0300 rstrau(2)=1. !nucl !effective ratio of u sea over u sea basis
0301 rstrad(2)=1. !effective ratio of d sea over u sea basis
0302 rstras(2)=0.7 !effective ratio of s sea over u sea basis
0303 rstrac(2)=1. !effective ratio of c sea over u sea basis
0304 rstrau(3)=1. !kaon !effective ratio of u sea over u sea basis
0305 rstrad(3)=1. !effective ratio of d sea over u sea basis
0306 rstras(3)=0.2 !effective ratio of s sea over u sea basis (kaons in kpp250)
0307 rstrac(3)=1. !effective ratio of c sea over u sea basis
0308 rstrau(4)=1. !j/psi!effective ratio of u sea over u sea basis
0309 rstrad(4)=1. !effective ratio of d sea over u sea basis
0310 rstras(4)=0.8 !effective ratio of s sea over u sea basis
0311 rstrac(4)=0.2 !effective ratio of c sea over u sea basis
0312 rstrasi=0.0 !effective ratio of strange sea over u sea increase
0313
0314
0315
0316
0317
0318 wgtqqq(1)=0.22 !weight for val diq (as soft string ends for one pomeron) for pion
0319 wgtqqq(2)=0.22 !weight for val diq for nucleon
0320 wgtqqq(3)=0.22 !weight for val diq for kaon
0321 wgtqqq(4)=0.22 !weight weight for val diq for J/Psi
0322
0323
0324 wgtdiq=0.15 !weight for seadiq - antidiq as soft string end
0325
0326
0327
0328
0329
0330 wgtval=0.15 !weight for valq - antiq as soft string ends
0331 wgtsea=0.85 !weight for seaq - antiq as soft string ends
0332 exmass=0.02 !excitation mass for remnant
0333 r3pom=0.01 !triple pomeron coupling (not used)
0334 r3pomi=r3pom !store
0335 r4pom=0.001 !4-pomeron coupling
0336 r4pomi=r4pom !store
0337 wexcit=0. !excitation in fremnu (for DIS)
0338 wproj=0. !not used
0339 wtarg=0. !not used
0340
0341
0342
0343
0344 gfactor=1000. !exp(-gfactor*Z) in front of eps in om5jk (to choose soft or hard)
0345 gwidth=0.62 !diff relative b-width
0346 ! gamhad(1) defined in psaini
0347 ! gamhad(3) defined in psaini
0348 gamhadsi(1)=0.55 !correction factor to gamma soft pion
0349 gamhadsi(3)=0.47 !correction factor to gamma soft kaon
0350 gamhadsi(4)=-1. !correction factor to gamma soft charm
0351 r2had(1)=1.5 !r2 pion
0352 r2had(3)=0.8 !r2 kaon
0353 r2had(4)=0. !r2 charm
0354 r2hads(1)=1.1 !diff corr factor pion
0355 r2hads(3)=1.1 !diff corr factor kaon
0356 r2hads(4)=1.25 !diff corr factor kaon
0357 chad(1)=1. !c pion
0358 chad(2)=1. !c proton
0359 chad(3)=1. !c kaon
0360 chad(4)=1. !c charm
0361 wdiff(1)=0.5 !diffractive probability
0362 wdiff(2)=0.7 !diffractive probability
0363 wdiff(3)=0.53 !diffractive probability
0364 wdiff(4)=0.1 !diffractive probability
0365 alplea(1)=0.7 !alpha leading pion
0366 alplea(2)=1. !alpha leading proton
0367 alplea(3)=0.7 !alpha leading kaon
0368 alplea(4)=1. !alpha leading jpsi
0369 rexndf=-1. !relative value of rexndi compare to rexdif if >0
0370
0371 rexdifi(1)=-0.8 !remnant excitation probability diffractive pion
0372 rexdifi(2)=-0.725!remnant excitation probability diffractive proton
0373 rexdifi(3)=-0.8 !remnant excitation probability diffractive kaon
0374 rexdifi(4)=1. !remnant excitation probability diffractive charmed
0375 rexpdif(1)=0. !remnant pion exchange probability diffractive pion
0376 rexpdif(2)=0.26 !remnant pion exchange probability diffractive proton
0377 rexpdif(3)=0. !remnant pion exchange probability diffractive kaon
0378 rexpdif(4)=0. !remnant pion exchange probability diffractive charmed
0379 rexndii(1)=0.4 !remnant excitation probability nondiffractive pion
0380 rexndii(2)=0.55 !remnant excitation probability nondiffractive proton
0381 rexndii(3)=0.6 !remnant excitation probability nondiffractive kaon
0382 rexndii(4)=1. !remnant excitation probability nondiffractive charmed
0383
0384 xmxrem=20. !maximum momentum fraction allowed to be given for remnant mass determination (very important for multiplicity and xf distri at low energy)
0385 xmindiff=1.35 !factor for minimum energy of pion exchange in prorem (change multiplicity and xf distribution of protons and neutrons)
0386 xminremn=1.25 !factor for minimum energy in prorem (change multiplicity of all remnants)
0387 rexres(1)=0.175 !pion remnant excitation probability in nucleus
0388 rexres(2)=0.1 !nucleon remnant excitation probability in nucleus
0389 rexres(3)=0.5 !kaon remnant excitation probability in nucleus
0390 rexres(4)=1. !charm remnant excitation probability in nucleus
0391 alpdif=0.45 !alpha mass diffractive for cross section and metropolis
0392 alpdi=0.45 !alpha mass diffractive
0393 alpndi=1.6 !alpha mass nondiffractive
0394 alpsea=0.3 !alpha string end x for sea parton
0395 alpval=0.3 !alpha string end x for valence parton
0396 alpdiq=0.3 !alpha string end x for sea diquark
0397 ammsqq=0.28 !minimum mass string quark quark
0398 ammsqd=1.08 !minimum mass string quark diquark
0399 ammsdd=1.88 !minimum mass string diquark diquark
0400 delrex=0.5 !excitation mass to be added to the minimal remnant mass when remnant is not connected to string (nuclear splitting)
0401 cumpom=ammsqq !cutoff mass for virtual pomerons (minimum= 2 pion mass)
0402 alpdro(1)=2. !factor for minimum mass of leading droplet (not less than 1.5 for kinematic reasons)
0403 alpdro(2)=0.3 !pt of leading droplet
0404 alpdro(3)=1.6 !alpha mass of leading droplet (iept=3)
0405
0406 iodiba=0. ! if iodiba=1, study H-Dibaryon (not used (see ProRef in epos-ems ????)
0407 bidiba=0.030 ! epsilon of H-Dibaryon
0408
0409
0410
0411
0412 epscrw=0.1 !overall factor for Z (Zsame,Zother)-> pp xsect .... w_Z
0413 epscrp=3. !b width param for Z -> pp xsection ............ w_B
0414 egyscr=3. !screening minimum energy -> pp xsection ........... s_M
0415 epscrd=0.1 !screening power for diffractive part
0416 epscrs=0.1 !screening power increase soft -> pp xsctn ........ alp_S
0417 epscrh=2.5 !screening power increase hard -> pp xsctn ........ alp_H
0418 epscrx=0.42 !screening power maxi -> pp xsctn
0419
0420
0421 znurho=1.65 !increase of Z due to nuclear effect -> pA xsctn (low E)
0422 zbrads=0.7 !factor for saturated radius of nucleon in nuclei for shadowing (nuclear saturation -> decrease pA xs)
0423 zbcut=0.7 !minimum diameter for shadowing (increase pA xs)
0424 zbrmax=0. !maximum b limit for nuclear splitting pairs (fix indirectly Zmax for nuclear collision (number of pair which can be connected to the main pair)
0425
0426
0427 zrminc=0.75 !increase probability for remnant excitation in nuclei (without connexion)
0428 ptvpom=0.30 !pt of virtual Pomerons (for getdropx)
0429 zodinc=0. !# pom dependence for increase of pt
0430 zipinc= 1.33 !inner pt modif factor increase
0431 zopinc= 0. !soft/hard modif factor increase
0432 zoeinc= 3. !cutoff timelike evol modif factor increase
0433 zdfinc=15. !z factor for a diffractive pomeron
0434 zdrinc= 0. !increase of droplet minimum mass (iremn>=2)
0435 zmsinc= 0.15 !increase of remant minimum mass and decrease alpha (increase remnant mass with iept=3)
0436 xzcut=3. !factor for minimum x for a Pomeron to be used for nuclear splitting
0437
0438
0439
0440 alpreg=0.734 !alpha_reggeon
0441 sloreg=0.499 !slope_reggeon
0442 gamreg=16.46 !gamma_reggeon
0443 r2reg=0.613 !r^2_reggeon
0444
0445
0446
0447 amhadr(1)=.14 !pion mass
0448 amhadr(2)=.939 !nucleon mass
0449 amhadr(3)=.496 !kaon mass
0450 amhadr(4)=1.868 !d-meson mass
0451 amhadr(6)=1.116 !lambda mass
0452 amhadr(5)=2.27 !lambda_c mass
0453 amhadr(7)=.548 !eta mass
0454 amhadr(8)=3.5 !J/psi mass
0455
0456
0457 qmass(0)=pmqq !diquark effective bounding energy (for pt distribtions)
0458 isospin(0)=0
0459 call idmass(1,qumass)
0460 qmass(1)=qumass !u quark effective mass (for pt distribtions)
0461 isospin(1)=1
0462 call idmass(2,qdmass)
0463 qmass(2)=qdmass !d quark effective mass (for pt distribtions)
0464 isospin(2)=-1
0465 call idmass(3,qsmass)
0466 qmass(3)=qsmass !s quark effective mass (for pt distribtions)
0467 isospin(3)=0
0468 call idmass(4,qcmass)
0469 qmass(4)=qcmass !c quark effective mass (for pt distribtions)
0470 isospin(4)=0
0471 call idmass(5,qbmass)
0472 qmass(5)=qbmass !b quark effective mass (for pt distribtions)
0473 isospin(5)=0
0474 call idmass(6,qtmass)
0475 qmass(6)=qtmass !t quark effective mass (for pt distribtions)
0476 isospin(6)=0
0477
0478
0479
0480 iokoll=0 !fix # of collisions (1)
0481 laproj=0 !projectile charge number
0482 maproj=0 !projectile mass number
0483 latarg=0 !target charge number
0484 matarg=0 !target mass number
0485 core=0.34 !hard core distance(2*0.17)
0486
0487 fctrmx=10 !parameter determining range for density distribution
0488 bmaxim=10000 !maximum impact parameter
0489 bminim=0. !minimum impact parameter
0490 phimax=2*3.1415927 !maximum phi
0491 phimin=0 !minimum phi
0492 iLHC=0 !LHC tune on(1)/off(0)
0493 ionudi=3 !nuclear diffraction included (>0) or not (0)
0494 ! = 0 for RHIC nuclear data based on glauber
0495 ! (no event with 0 collision "a la Glauber")
0496 ! = 1 for cosmic ray simulations (diffraction without
0497 ! excitation counted as inelastic
0498 ! to be consistent with sigma_ine used for CR)
0499 ! = 2 for fixed target accelerator data cross section
0500 ! (diffractive without projectile excitation = elastic)
0501 ! = 3 real inelastic (no trigger effect)
0502 ! (diffractive without excitation = elastic (but not for LHC because a Pomeron is present))
0503
0504
0505
0506 iorsce=0 !color exchange turned on(1) or off(0)
0507 iorsdf=3 !droplet formation turned on(>0) or off(0)
0508 iorshh=0 !other hadron-hadron int. turned on(1) or off(0)
0509 iocluin=1 !include inwards moving corona segments into clusters (1) or not (0)
0510 ioquen=0 !jet quenching option (0=no)
0511 iohole=0 !hole filling option (0=no)
0512 fploss=0. !parton energy loss (effective)
0513 fplmin=0. !minimum pl for rescaled particles after flow
0514 fvisco=-50. !viscosity (effective)
0515 taumin=1.0 !min tau for rescattering
0516 taurea=1.0 !reaction time (=formation time)
0517 nsegsu=30 !number of segments per subcluster
0518 nsegce=4 !number of segments per cell
0519 kigrid=1 !long grid number increase factor
0520 fsgrid=1.0 !sgrid factor
0521 ptclu=3 !obove this: string segments escape cluster
0522 amimfs=1.0 !below this: elastic
0523 amimel=0.050 !below this: nothing
0524 delamf=1 !above this: color exch !cutoffs for kinetic energy
0525 deuamf=1 !above this: nothing !mass - minimum mass of pair
0526 epscri(1)=0.15!energy density for hnbaaa
0527 epscri(3)= -1 !read in from table
0528
0529
0530
0531 amsiac=.8 !interaction mass
0532 amprif=0 !print option
0533 delvol=1 !print option
0534 deleps=1 !print option
0535 deltau=0.2 !initial delta_tau for space-time evolution
0536 factau=1.05 !factor for delta_tau for space-time evolution
0537 numtau=80 !number of tau steps for space-time evolution
0538 dlzeta=0.5 !delta_zeta for longitudinal droplet binning
0539 etafac=1.0 !factor determining inner range
0540 facnuc=0.0 !factor for nuclear size to determine inner range
0541 hacore=0.8 !hadron compressibility factor
0542 cepara=0.03 !parameter for excitation for color exchange
0543 dscale=1. !scale parameter for hadron-hadron
0544 iceopt=1 !real color exchange (1) or just excitation (0)
0545
0546
0547
0548 iurqmd=0 ! call eposurqmd (1) or not
0549
0550
0551
0552 ispherio=0 !call spherio
0553 cutico=3 !cutoff parameter for smoothing kernel in epos-ico
0554 ! (as small as possible with stable results)
0555 dssico=0.2 !s step size for string integration in epos-ico
0556 ! (as big as possible with stable results)
0557 icocore=0 !consider core initial condition (1 or 2)
0558 icotabm=0 !make table for initial condition stuff
0559 icotabr=0 !read table for initial condition stuff
0560
0561
0562
0563 ioclude=3 !cluster decay option
0564 amuseg=4.0 !min mass for radial boost (limit=amuseg+yrmax(E))
0565 yradmx= 0.5 !max radial collective boost
0566 yradmi= 0.12 !max radial collective boost increase
0567 yradpp=1. !max radial collective boost
0568 yradpi=0. !max radial collective boost increase
0569 yradpx=0. !not used
0570 facecc=0.45 !eccentricity parameter
0571 ylongmx=-1. !max long collective boost ( < 0 -> take from jintpo )
0572 rcoll=0.0 !radial collective flow param
0573 bag4rt=0.200 !bag constant ^1/4
0574 taunll=1.0 !decay time (comoving frame)
0575 vrad=0.3
0576 facts=0.3 !gamma-s factor
0577 factb=1 !gamma-s factor baryons
0578 factq=1 !gamma-qqbar
0579
0580
0581
0582 asuhax(1)=1.134 !two lowest multiplets
0583 asuhax(2)=1.301 !two lowest multiplets
0584 asuhax(3)=1.461 !two lowest multiplets
0585 asuhax(4)=1.673 !two lowest multiplets
0586 asuhax(5)=0.7700 !two lowest multiplets rho
0587 asuhax(6)=0.8920 !two lowest multiplets K*
0588 asuhax(7)=1.2320 !two lowest multiplets
0589 asuhay(1)=0.940 !lowest multiplet
0590 asuhay(2)=1.200 !lowest multiplet
0591 asuhay(3)=1.322 !lowest multiplet
0592 asuhay(4)=1.673 !lowest multiplet
0593 asuhay(5)=0.1400 !lowest multiplet
0594 asuhay(6)=0.4977 !lowest multiplet
0595 asuhay(7)=1.2320 !lowest multiplet
0596
0597
0598
0599 keu=0 !u flavour of droplet
0600 ked=0 !d flavour of droplet
0601 kes=0 !s flavour of droplet
0602 kec=0 !c flavour of droplet
0603 keb=0 !b flavour of droplet
0604 ket=0 !t flavour of droplet
0605 tecm=10 !energy of droplet
0606 volu=70 !volume of droplet
0607
0608
0609
0610 iospec=10 !option for particle species
0611 iocova=1 !covariant (1) or noncovariant (2) phase space integral
0612 iopair=2 !single pair (1) or double pair (2) method
0613 iozero=65 !relative weight of zeros (compared to hadrons)
0614 ! (-1) nspecs
0615 ! (-2) nspecs/sqrt(tecm/volu)
0616 ioflac=1 !test multipl distr without (1) or with (2) flavour conserv
0617 ! (2 only good for nspecs=3,7)
0618 iostat=1 !use boltzmann (1) or quantum (0) statistics in hgc-routines
0619 ioinco=1 !call hnbmin for initial configuration (0)
0620 !call hgcnbi for initial configuration to generate better
0621 !initial configuration (1)
0622 !call hgcnbi for initial configuration to generate optimal
0623 !initial configuration (2)
0624 iograc=1 !call hgcaaa in case of ioinco=0 (1)
0625 epsgc=2. !required accuracy in hgcaaa 10**(-epsgc)
0626 iocite=0 !perform counting at metropolis iterations (1) or not (else)
0627 ioceau=0 !perform counting for exp. autocorrel. time (1) or not (else)
0628 iociau=0 !perform counting for int. autocorrel. time (1) or not (else)
0629 ioinct=0 !test grand canonical metropolis sampling (1)
0630 !to plot results call xhgccc, xhgcfl and xhgcam
0631 ioinfl=1 !conserve flavor in initial configuration in hgcnbi (1)
0632 !do not conserve flavor (0)
0633 !do not conserve flavor and energy (-1)
0634 iowidn=2 !width of total multiplicity distribution in hgcnbi
0635 ! sigma_tot -> sigma_tot/iowidn
0636 ! >0 unnormalized
0637 ! <0 normalized
0638 ionlat=2 !determine nlattc ,old method (0)
0639 !or determine nlattc in hgcnbi as:
0640 ! (1) max(1.3*<N>,<N>+2*sigma,6)
0641 ! (2) max(1.5*<N>,<N>+3*sigma,6)
0642 ! (3) max(2.0*<N>,<N>+4*sigma,6)
0643 iomom=1 !number of momenta to be changed in hnbodz
0644 ioobsv=0 !observable for autocorrelation time calculation
0645 !0: total multiplicity
0646 !else: particle id for particle species
0647 iosngl=0 !event # for which counting at metropolis iterations is done
0648 iorejz=0 !reject pair exchange with only zeros (1) or not (else)
0649 iompar=4 !parameter for windowing algorithm
0650 iozinc=0 !if iozevt>0: modifies iozero for testing (in sr hgcnbi)
0651 iozevt=0 !if >0: modifies iozero for testing (in sr hgcnbi)
0652 nadd=0 !number of pi0s added to minimum initial configuration
0653 iterma=-6 !>0: maximum number of iterations
0654 !<0: - number of iterations per corr time
0655 iterpr=10000 !iter-increment for printout
0656 iterpl=1 !iter-increment for plot
0657 iternc=50 !iterations not counted for analysis
0658 epsr=1e-4 !required accuracy in sr hnbraw
0659 keepr=1 !keep most random numbers rnoz in hnbodz (1)
0660 ! or update all (0)
0661
0662
0663
0664 iopenu=1 !option for minimum energy
0665 !1: sum of hadron masses
0666 !2: bag model curve with minimum at nonzero strangen
0667 themas=.51225 !parameter theta in berger/jaffe mass formula
0668
0669
0670
0671 iotst1=0 !test
0672 iotst2=0 !test
0673 iotst3=0 !test
0674 iotst4=0 !test
0675
0676
0677
0678 jpsi=0 !jpsi to be produced (1) or not (0)
0679 jpsifi=0 !jpsi final state interaction (1) or not (0)
0680 sigj=0.2 !jpsi nucleon cross section [fm**2]
0681 taumx=20 !max time for jpsi evolution
0682 nsttau=100 !time steps for jpsi evolution
0683 ijphis=0 !fill jpsi histograms (1) or not (0)
0684
0685
0686
0687 ymximi=2 !upper limit for rapidity interval for intermittency analysis
0688 imihis=0 !fill intermittency histograms (1) or not (0)
0689 isphis=0 !fill space-time histograms (1) or not (0)
0690 iologb=0 !0=linear bins 1=log bins
0691 ispall=1 !xspace: all ptls (1) or only interacting ptls (else)
0692 wtmini=-3 !tmin in xspace
0693 wtstep=1 !t-step in xspace
0694 iwcent=0 !only central point (1) or longitudinal distr (else) in xspace
0695 iclhis=0 !fill droplet histograms (1) or not (0)
0696 iwtime=0 !fill formation time histogram (1) or not (else)
0697 wtimet=100 !max time in wtime
0698 wtimei=0 !max mass in wtime
0699 wtimea=1000 !max mass in wtime
0700
0701
0702
0703 maxrec(1)=7
0704 irecty(1,1)=1
0705 irecty(2,1)=2
0706 irecty(3,1)=3
0707 irecty(4,1)=4
0708 irecty(5,1)=5
0709 irecty(6,1)=6
0710 irecty(7,1)=7
0711 maxrec(2)=14
0712 irecty(1,2)=1
0713 irecty(2,2)=2
0714 irecty(3,2)=3
0715 irecty(4,2)=4
0716 irecty(5,2)=5
0717 irecty(6,2)=6
0718 irecty(7,2)=7
0719 irecty(8,2)=8
0720 irecty(9,2)=9
0721 irecty(10,2)=10
0722 irecty(11,2)=11
0723 irecty(12,2)=12
0724 irecty(13,2)=13
0725 irecty(14,2)=14
0726
0727
0728
0729
0730 gaumx=8 !range for gauss distribution
0731 nclean=1 !clean /cptl/ if nclean > 0
0732 !(not for part with istptl<istmax if nclean=1 (do not change analysis)
0733 ! for all part with ist.ne.0 if nclean > 1 (particle nb reduce at max))
0734 istore=0 !0: no storage to data-file
0735 !-1: epos full info (fixed format)
0736 !1: epos standard
0737 !2: OSC1997A standart
0738 !3: OSC1999A standart
0739 !4: Les Houches Event Format (LHEF) standart
0740 !5: calls routine ustore (modifiable by the user)
0741 ioidch=1 !id choice for storage to data-file
0742 iframe=0 !frame specification production run
0743 jframe=0 !frame specification analysis
0744 kframe=0 !frame specification analysis (2nd frame)
0745 ! 1:total
0746 !11:nucleon-nucleon
0747 !12:target
0748 !21:gamma-nucleon
0749 !22:lab
0750 !32:sphericity
0751 !33:thrust
0752 irescl=1 !momentum rescaling (1) or not (0)
0753 ifrade=1 !suppression of fragmentation and decay (0)
0754 idecay=1 !suppression of decay (0)
0755 jdecay=1 !suppression of cluster decay (0), concerns only ity=60 cluster
0756 iremn=2 !suppression of multiquark remnant (0) (string end with same flavor) -> reduce remnant excitation and suppress droplet prod. in remnant
0757 !or full multiquark remnant (no limitations) (1)
0758 !or multiquark remnant with valence quark conservation and inelastic remnant as low mass droplet only (2)
0759 !or suppression of multiquark remnant with different string end flavors (3)
0760 ntrymx=10 !try-again parameter
0761 istmax=1 !analyse only istptl <= istmax
0762 irdmpr=0 !random sign for projectile if 1
0763 ilprtg=1 !consider leading particle in projectile (1)
0764 !or target (-1) side
0765
0766
0767
0768 pi=3.1415927
0769 pii=1./(2*pi**2)
0770 hquer=0.197327
0771 prom=.94
0772 piom=.14
0773 ainfin=1e31
0774
0775
0776
0777 airanxs(1)=14.007
0778 airznxs(1)=7.
0779 airwnxs(1)=0.781
0780 airanxs(2)=15.999
0781 airznxs(2)=8.
0782 airwnxs(2)=.21
0783 airanxs(3)=39.948
0784 airznxs(3)=18.
0785 airwnxs(3)=0.009
0786 airavanxs=airanxs(1)*airwnxs(1)+airanxs(2)*airwnxs(2)
0787 & +airanxs(3)*airwnxs(3)
0788 airavznxs=airznxs(1)*airwnxs(1)+airznxs(2)*airwnxs(2)
0789 & +airznxs(3)*airwnxs(3)
0790
0791
0792
0793 ixgeometry=0
0794 ixbDens=0
0795 ixtau=0
0796 iEmsB=0
0797 iEmsBg=0
0798 iEmsPm=0
0799 iEmsPx=0
0800 iEmsSe=0
0801 iEmsDr=0
0802 iEmsRx=0
0803 iEmsI2=0
0804 iEmsI1=0
0805 iSpaceTime=0
0806 nemsi=0
0807 facmss=1.
0808 nstmax=0
0809 do 6 i=1,99
0810 prob(i)=0
0811 do 6 j=1,2
0812 icbac(i,j)=0
0813 6 icfor(i,j)=0
0814 imsg=0
0815 do j=1,mxjerr
0816 jerr(j)=0
0817 enddo
0818 ntevt=0
0819 nrevt=0
0820 naevt=0
0821 nrstr=0
0822 nrptl=0
0823 nptlu=0
0824 do itau=1,mxtau
0825 volsum(itau)=0
0826 vo2sum(itau)=0
0827 nclsum(itau)=0
0828 do ivol=1,mxvol
0829 do ieps=1,mxeps
0830 clust(itau,ivol,ieps)=0
0831 enddo
0832 enddo
0833 enddo
0834 iutotc=0
0835 iutote=0
0836 nopen=0
0837 nopenr=0
0838 knxopen=0
0839 kchopen=0
0840 khiopen=0
0841 kdtopen=0
0842 klgopen=0
0843 ifdat=0
0844 ifncs=0
0845 xpar1=0.
0846 xpar2=0.
0847 xpar3=0.
0848 xpar4=0.
0849 xpar5=0.
0850 xpar6=0.
0851 xpar7=0.
0852 xpar8=0.
0853 if(iop.eq.0)khisto=0
0854 nrclu=0
0855 nrnody=0
0856 do n=1,mxnody
0857 nody(n)=0
0858 enddo
0859 nrpri=0
0860 ctaumin=-1.
0861 do n=1,mxpri
0862 subpri(n)=' '
0863 ishpri(n)=0
0864 enddo
0865 nctcor=0
0866 ncttim=0
0867 do n=1,matau
0868 tauv(n)=0
0869 enddo
0870 ncnt=0
0871 nrnucl(1)=0
0872 nrnucl(2)=0
0873 do i=1,mxnucl
0874 rnucl(i,1)=0
0875 rnucl(i,2)=0
0876 rnuclo(i,1)=0
0877 rnuclo(i,2)=0
0878 bnucl(i,1)=0
0879 bnucl(i,2)=0
0880 bnucl(i,3)=0
0881 bnucl(i,4)=0
0882 enddo
0883 xbtot(1)=0.
0884 xbtot(2)=0.
0885 inicnt=0
0886 accept=0.
0887 reject=0.
0888 do n=1,matau
0889 tauv(n)=0.
0890 enddo
0891 anquasiel=0.
0892 nglacc=0
0893 ifset=1
0894
0895 1002 continue ! ----> entry iop=2 <----
0896
0897
0898
0899
0900 xvaria='numptl'
0901 yvaria='ycmptl'
0902 normal=11
0903 xminim=-100
0904 xmaxim=100
0905 nrbins=100
0906 hisfac=1
0907 do nr=1,mxbins
0908 do l=1,5
0909 ar(nr,l)=0
0910 enddo
0911 enddo
0912 nozero=0
0913 ibmin=1
0914 ibmax=1e8
0915
0916 return
0917 end
0918
0919
0920 subroutine LHCparameters
0921
0922 include 'epos.inc'
0923 include 'epos.incpar'
0924 include 'epos.incsem'
0925
0926 iLHC=1
0927
0928
0929 infragm=2 !nuclear fragmentation
0930
0931
0932
0933 epscrw=0.3 !overall factor for Z (Zsame,Zother)-> pp xsect .... w_Z
0934 epscrp=1.25 !b width param for Z -> pp xsection ............ w_B
0935 egyscr=3. !screening minimum energy -> pp xsection ........... s_M
0936 epscrd=0.21 !screening power for diffractive part
0937 epscrs=0. !screening power increase soft -> pp xsctn ........ alp_S
0938 epscrh=2.2 !screening power increase hard -> pp xsctn ........ alp_H
0939 epscrx=0.4 !screening power maxi -> pp xsctn
0940 znurho=2.5 !increase of Z due to nuclear effect -> pA xsctn (low E)
0941 zbrads=0.6 !factor for saturated radius of nucleon in nuclei for shadowing (nuclear saturation -> decrease pA xs)
0942 zbcut=0.6 !minimum diameter for shadowing (increase pA xs)
0943
0944
0945
0946 r2had(1)=1. !r2 pion
0947 r2had(2)=0.85 !r2 proton
0948 r2had(3)=0.7 !r2 kaon
0949 r2had(4)=0. !r2 charm
0950 r2hads(1)=1. !diff corr factor pion
0951 r2hads(2)=1. !diff corr factor proton
0952 r2hads(3)=1. !diff corr factor kaon
0953 r2hads(4)=1. !diff corr factor charm
0954 wdiff(1)=0.7 !diffractive probability
0955 wdiff(2)=0.875 !diffractive probability
0956 wdiff(3)=0.65 !diffractive probability
0957 wdiff(4)=0.1 !diffractive probability
0958 facdif=0.7 !factor for diffractive profile
0959 slopom=0.18 !alpha prime pomeron
0960 slopoms=0.26 !alpha prime pomeron dif
0961 gwidth=1.4 !diff relative b-width
0962
0963
0964
0965 rexpdif(2)=0.28 !remnant pion exchange probability diffractive proton
0966 rexdifi(2)=-0.65 !remnant excitation probability diffractive proton
0967 rexndii(1)=0.65 !remnant excitation probability nondiffractive pion
0968 rexndii(2)=0.65 !remnant excitation probability nondiffractive proton
0969 rexndii(3)=0.65 !remnant excitation probability nondiffractive kaon
0970 rexres(1)=0. !pion remnant excitation probability in nucleus
0971 rexres(2)=0. !nucleon remnant excitation probability in nucleus
0972 rexres(3)=0.15 !kaon remnant excitation probability in nucleus
0973 alpdif=0.7 !alpha mass diffractive for cross section and metropolis
0974 alpdi=1.05 !alpha mass diffractive
0975 alpndi=2. !1.65 !alpha mass nondiffractive
0976 alpdro(3)=2.5 !alpha mass of leading droplet (iept=3)
0977 alpdro(2)=1.5 !alpha mass of leading droplet (iept=3)
0978 zmsinc= 0. !increase of remant minimum mass and decrease alpha (increase remnant mass with iept=3)
0979 zrminc= 0. !increase probability for remnant excitation in nuclei (without connexion)
0980
0981
0982
0983 pbreak=-0.4 !break-parameter (~0.4 to match NA49 data and pi0 spectra for CR)
0984 pbreakg=0.15 !minimum pbreak at high energy in e+e- parameterization
0985 zetacut=1.5 !g->ggq2 cut for special hadronization
0986 fkappa=0.014 !String tension (GeV2) for quark string
0987 fkappag=0.014 !String tension (GeV2) for gluon string
0988 ptfraqq=0. !pt for rotation of string in remnant
0989 ptsend=1. !string end pt
0990 ptsems=0.2
0991 pmqq=0.107 !mass diquark for string fragm (fix number of baryons)
0992 qmass(0)=0. !diquark effective bounding energy (for pt distribtions)
0993 pmqs=0.074 !mass quark s for string fragm
0994 rstras(1)=0.5 !effective ratio of s sea over u sea basis (kaons in pipp250)
0995 rstras(2)=0.5 !effective ratio of s sea over u sea basis (lambdas in pp158)
0996 rstras(3)=0.5 !effective ratio of s sea over u sea basis (kaons in kpp250)
0997 wgtdiq=0.25 !weight for seadiq - antidiq as string end
0998 wgtqqq(1)=0. !weight for val diq (as soft string ends for one pomeron) for pion
0999 wgtqqq(2)=0. !weight for val diq for nucleon
1000 wgtqqq(3)=0. !weight for val diq for kaon
1001 wgtqqq(4)=0. !weight weight for val diq for J/Psi
1002 fkainc=0. !factor for natural increase of string tension with energy
1003
1004
1005 fkamax=10000. !limit of effect in hadronic collision on fkappa
1006 zopinc= 0.007 !soft/hard modif factor increase
1007 zipinc= 1.35 !inner pt modif factor increase
1008 zodinc= 0. !#of pom dependence
1009 xzcut=3.35 !factor for minimum x for a Pomeron to be used for nuclear splitting
1010 zoeinc= 0. !cutoff timelike evol modif factor increase
1011 reminv=0.05 !remnant inversion probability (inversion important for forward pi(0) spectra : consequences on Xmax)
1012
1013
1014 yradpx=0.55 !increase factor of low mass flow (conserv. mult.)
1015 yradpp=4. !mass dependence of low mass flow (attenuation for heavy part)
1016
1017
1018 yradmx= 0.04 !increase factor of high mass flow (decrease. mult.)
1019 yradpi= 10.7 !minimum for rad flow (min=yradpi*yradmx)
1020
1021
1022 ylongmx=-0.106 !long collective boost ( < 0 -> factor for mass dependence)
1023 yradmi= 9.2 !minimum for long flow (min=yradmi*ylongmx)
1024
1025 ptclu=1. !maximum pt of particles going into cluster (this change <pt> because the maximum flow will depend on ptclu**yradpp and multiplicity because less particles are inculded in clusters (can be compensated by fploss)
1026 ioquen=1 !jet quenching option (0=no)
1027 iohole=0 !hole filling option (0=no)
1028 fploss=1.75 !parton energy loss (effective)
1029 fvisco=1.3 !factor to correct # of segment in high density pair vs all
1030 fplmin=-2.5 !fix the eta shape at high pt
1031 amuseg=3. !min mass for radial boost
1032 facecc=0.5 !max eccentricity parameter
1033 nsegce=7 !number of segments per cell
1034
1035 facts=0.35 !strangeness suppression in droplet
1036 factb=0.35 !baryon increase in droplet
1037
1038
1039 end
1040
1041
1042 subroutine estore
1043
1044
1045
1046
1047
1048 include 'epos.inc'
1049
1050
1051
1052 nptevt=0
1053 do i=1,nptl
1054 if(istptl(i).le.istmax)nptevt=nptevt+1
1055 enddo
1056
1057
1058 write(ifdt,*)nptevt,bimevt,phievt,kolevt,pmxevt,egyevt
1059 * ,npjevt,ntgevt,qsqevt,typevt
1060 do n=1,nptl
1061
1062 if(istptl(n).le.istmax)then !store events with istptl < istmax
1063
1064 write(ifdt,*)n,idptl(n),pptl(1,n),pptl(2,n),pptl(3,n),pptl(4,n)
1065 * ,pptl(5,n),iorptl(n),jorptl(n),istptl(n),ityptl(n)
1066 * ,xorptl(1,n),xorptl(2,n),xorptl(3,n),xorptl(4,n)
1067 * ,ifrptl(1,n),ifrptl(2,n),dezptl(n)
1068
1069 endif
1070
1071 enddo
1072 write(ifdt,'(A)') ' ' !to finish the file
1073
1074 return
1075 end
1076
1077
1078 subroutine hepmcstore
1079
1080
1081
1082
1083 include 'epos.inc'
1084 double precision phep2,vhep2
1085 integer nhep2,isthep2,idhep2,jmohep2,jdahep2
1086
1087 dimension isthep2(nmxhep),idhep2(nmxhep),jmohep2(2,nmxhep)
1088 &,jdahep2(2,nmxhep),phep2(5,nmxhep),vhep2(4,nmxhep)
1089 integer iepo2hep(mxptl),ihep2epo(nmxhep),ihep2epo2(nmxhep)
1090
1091 logical lrcore,lrcor0,lclean
1092
1093
1094
1095 do i=1,nptl
1096 iepo2hep(i)=0 !initialize epos index to hep index
1097 enddo
1098 do j=1,nmxhep
1099 ihep2epo(j)=0 !initialize hep index to epos index
1100 ihep2epo2(j)=0 !initialize 2nd hep index to epos index
1101 enddo
1102
1103
1104
1105
1106
1107
1108 nevhep=nrevt
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126 if(istmax.gt.0.and.ioclude.ne.0)then
1127 istmaxhep=2
1128 else
1129 istmaxhep=min(istmax,1)
1130 endif
1131
1132 nhep2=0
1133 ipro=0
1134 itar=0
1135 do i=1,nptl
1136
1137 if(istptl(i).le.istmaxhep.or.i.le.maproj+matarg)then !store events with istptl < istmax
1138
1139
1140
1141
1142
1143 io=iorptl(i)
1144 lclean=.false.
1145 if(istptl(i).le.1.and.io.eq.0.and.i.gt.maproj+matarg)then
1146 lclean=.true. !happens only after cleaning
1147 io=i
1148 endif
1149 iadd=1
1150 jm1io=0
1151 jm2io=0
1152 jd1io=0
1153 jd2io=0
1154 jm1hep=0
1155 jm2hep=0
1156 jd1hep=0
1157 jd2hep=0
1158 idio=0
1159 if(io.gt.0)then
1160 if(istptl(io).le.1.and.i.gt.maproj+matarg.and..not.lclean)then!mother is normal particle (incl. spectators and fragments)
1161 iadd=1
1162 jm1hep=iepo2hep(io)
1163 if(jorptl(i).gt.0)jm2hep=iepo2hep(jorptl(i))
1164 elseif(istmaxhep.gt.0.and.(iorptl(io).gt.0.or.lclean))then
1165
1166 if(lclean)then
1167 istptlio=99 !if cleaning defined: use all remnants
1168 iorptlio=io
1169 else
1170 do while(iorptl(iorptl(io)).gt.0)
1171 io=iorptl(io)
1172 enddo
1173 istptlio=istptl(io)
1174 iorptlio=iorptl(io)
1175 endif
1176 if(istptlio.eq.41)then !remnant
1177 if(istptl(i).eq.2.and.jdahep2(2,iorptl(io)).eq.0)then !beam remnant used in core
1178 ifrptl(1,iorptl(io))=io !no to be used again as core mother
1179 jmohep2(2,iorptl(io))=1
1180
1181 elseif(istptl(i).le.1)then
1182 iadd=2
1183 idio=93
1184 jm1io=iorptl(io)
1185 jd1io=nhep2+2
1186 jm1hep=nhep2+1
1187 jmohep2(2,jm1io)=-1
1188 jdahep2(2,jm1io)=i
1189
1190 endif
1191 elseif(istptl(i).le.1.and.istptlio.eq.31)then !string
1192 iadd=2
1193 idio=92
1194 if(pptl(3,i).ge.0.)then
1195 jm1io=iorptl(io)
1196 else
1197 jm1io=jorptl(io)
1198 endif
1199 jd1io=nhep2+2
1200 jm1hep=nhep2+1
1201 jdahep2(2,jm1io)=i
1202 jmohep2(2,jm1io)=-1
1203
1204 elseif(istptl(i).le.1.and.istptlio.eq.11)then !core
1205 iadd=2
1206 idio=91
1207 jm1io=1
1208 dddmn=1e33
1209 if(jorptl(iorptlio).eq.0)then
1210 jm1io=1
1211 dddmn=1e33
1212 do k=1,maproj !look for closest projectile nucleon
1213 ddd=1e34
1214 if(iorptl(k).lt.0.and.ifrptl(1,k).eq.0)
1215 & ddd=(xorptl(1,k)-xorptl(1,io))**2
1216 & +(xorptl(2,k)-xorptl(2,io))**2
1217 if(ddd.lt.dddmn)then
1218 jm1io=k
1219 dddmn=ddd
1220 endif
1221 enddo
1222 jm2io=1
1223 dddmn=1e33
1224 do k=maproj+1,maproj+matarg !look for closest target nucleon
1225 ddd=1e34
1226 if(iorptl(k).lt.0.and.ifrptl(1,k).eq.0)
1227 & ddd=(xorptl(1,k)-xorptl(1,io))**2
1228 & +(xorptl(2,k)-xorptl(2,io))**2
1229 if(ddd.lt.dddmn)then
1230 jm2io=k
1231 dddmn=ddd
1232 endif
1233 enddo
1234 iorptl(io)=jm1io
1235 jorptl(io)=jm2io
1236 jorptl(iorptl(io))=io
1237 jm1io=0
1238 jm2io=0
1239 endif
1240 if(pptl(3,i).ge.0.)then
1241 jm1io=iorptl(io)
1242 else
1243 jm1io=jorptl(io)
1244 endif
1245
1246 jd1io=nhep2+2
1247 jm1hep=nhep2+1
1248 jdahep2(2,jm1io)=i
1249 jmohep2(2,jm1io)=-1
1250
1251 elseif(istptl(i).le.1.and.istptlio.eq.51)then !nuclear fragment
1252 idio=90
1253 if(jorptl(io).gt.0)then
1254 iadd=2
1255 jm1io=iorptl(io)
1256
1257 jm1hep=nhep2+1
1258 jorptl(io)=0
1259 else
1260 iadd=1
1261 jm1hep=iepo2hep(io)
1262 endif
1263 elseif(istptlio.eq.99)then !particle after cleaning
1264 iadd=2
1265 idio=91
1266 if(pptl(3,i).ge.0.)then
1267 ipro=ipro+1
1268 if(ipro.gt.maproj)ipro=1
1269 jm1io=ipro
1270 else
1271 itar=itar+1
1272 if(itar.gt.matarg)itar=1
1273 jm1io=maproj+itar
1274 endif
1275
1276 jd1io=nhep2+2
1277 jm1hep=nhep2+1
1278 jdahep2(2,jm1io)=i
1279 jmohep2(2,jm1io)=-1
1280
1281 endif
1282 endif
1283 else
1284 jm1hep=-1
1285 jm2hep=-1
1286 jd1hep=ifrptl(1,i)
1287 jd2hep=ifrptl(2,i)
1288 endif
1289
1290 if(istptl(i).gt.1)goto 100 !skip non final particles (allowed before to define correctly some spectators going to core)
1291
1292 idpdg=idtrafo('nxs','pdg',idptl(i))
1293 if(idpdg.eq.99)then
1294 print *,'Skip particle',i,idptl(i)
1295 goto 100
1296 endif
1297
1298 if(nhep2+iadd.gt.nmxhep)then
1299 print *,'Warning : produced number of particles is too high'
1300 print *,' Particle list is truncated, skip event !'
1301 goto 10000
1302 endif
1303 do j=1,iadd
1304 nhep2=nhep2+1
1305 if(j.eq.1.and.iadd.eq.2)then
1306 ii=io
1307 ix=jm1io !for position we use father position
1308 id=idio
1309 jm1=iepo2hep(jm1io)
1310 jm2=0
1311 if(jm2io.gt.0)jm2=iepo2hep(jm2io)
1312 jd1=jd1io
1313 jd2=jd2io
1314 if(id.eq.90)ihep2epo2(nhep2)=ii
1315 else
1316 ii=i
1317 ix=i
1318 id=idpdg
1319 jm1=jm1hep
1320 jm2=jm2hep
1321 jd1=jd1hep
1322 jd2=jd2hep
1323 if(ii.gt.maproj+matarg.or.jd1.gt.0)ihep2epo2(nhep2)=ii
1324 endif
1325 iepo2hep(ii)=nhep2
1326
1327 idhep2(nhep2)=id
1328
1329 phep2(1,nhep2)=dble(pptl(1,ii))
1330
1331 phep2(2,nhep2)=dble(pptl(2,ii))
1332
1333 phep2(3,nhep2)=dble(pptl(3,ii))
1334
1335 phep2(4,nhep2)=dble(pptl(4,ii))
1336
1337 phep2(5,nhep2)=dble(pptl(5,ii))
1338
1339 isthep2(nhep2)=min(2,istptl(ii)+1) !in hep:1=final, 2=decayed
1340 if(i.le.maproj+matarg)isthep2(nhep2)=4 !beam particles
1341
1342
1343 vhep2(1,nhep2)=xorptl(1,ix)*1e-12 !conversion to mm
1344
1345 vhep2(2,nhep2)=xorptl(2,ix)*1e-12 !conversion to mm
1346
1347 vhep2(3,nhep2)=xorptl(3,ix)*1e-12 !conversion to mm
1348
1349 vhep2(4,nhep2)=xorptl(4,ix)*1E-12 !conversion to mm/c
1350
1351
1352
1353 jdahep2(1,nhep2)=jd1 !need a second loop to calculated proper indice
1354
1355 jdahep2(2,nhep2)=jd2 !need a second loop to calculated proper indice
1356
1357 jmohep2(1,nhep2)=jm1
1358
1359 jmohep2(2,nhep2)=jm2
1360
1361 enddo
1362
1363 100 continue
1364
1365 endif
1366 enddo
1367
1368
1369
1370 nhep=0
1371 nhepio=0
1372 if(istmaxhep.ne.0)nhep=maproj+matarg
1373 lrcor0=.true. !link spectator remnants to core only once
1374 lrcore=.false.
1375
1376
1377
1378 do j=1,maproj+matarg
1379
1380 if(istmaxhep.eq.0)then
1381
1382
1383 nhep=nhep+1
1384 nhepio=nhepio+1
1385 idhep(nhep)=idhep2(j)
1386 phep(1,nhep)=phep2(1,j)
1387 phep(2,nhep)=phep2(2,j)
1388 phep(3,nhep)=phep2(3,j)
1389 phep(4,nhep)=phep2(4,j)
1390 phep(5,nhep)=phep2(5,j)
1391 isthep(nhep)=4
1392 vhep(1,nhep)=vhep2(1,j)
1393 vhep(2,nhep)=vhep2(2,j)
1394 vhep(3,nhep)=vhep2(3,j)
1395 vhep(4,nhep)=vhep2(4,j)
1396 jmohep(1,nhep)=-1
1397 jmohep(2,nhep)=-1
1398 jdahep(1,nhep)=0
1399 jdahep(2,nhep)=0
1400 iepo2hep(j)=nhep
1401 isthep2(j)=-isthep2(j)
1402 ihep2epo2(j)=-nhep
1403
1404 else
1405
1406 nhep0=nhep
1407 nhepi0=nhepio+1
1408 isthep(nhepi0)=0
1409 nio=0
1410
1411
1412 do k=maproj+matarg+1,nhep2
1413
1414 if(jmohep2(1,k).eq.j.and.idhep2(k).ne.90)then
1415 if(isthep(nhepi0).eq.0)then !first save mother beam particle
1416 nhepio=nhepio+1
1417 idhep(nhepio)=idhep2(j)
1418 phep(1,nhepio)=phep2(1,j)
1419 phep(2,nhepio)=phep2(2,j)
1420 phep(3,nhepio)=phep2(3,j)
1421 phep(4,nhepio)=phep2(4,j)
1422 phep(5,nhepio)=phep2(5,j)
1423 isthep(nhepio)=4
1424 vhep(1,nhepio)=vhep2(1,j)
1425 vhep(2,nhepio)=vhep2(2,j)
1426 vhep(3,nhepio)=vhep2(3,j)
1427 vhep(4,nhepio)=vhep2(4,j)
1428 jmohep(1,nhepio)=-1
1429 jmohep(2,nhepio)=-1
1430 iepo2hep(j)=nhepio
1431 isthep2(j)=-isthep2(j)
1432 ihep2epo2(j)=-nhepio
1433 lrcore=.false. !link spectator remnants to core only once
1434 if(lrcor0)then
1435 kk=k
1436 do while (kk.le.nhep2.and..not.lrcore)
1437 if(idhep2(kk).eq.91.and.jmohep2(1,kk).eq.j)lrcore=.true.
1438 kk=kk+1
1439 enddo
1440 endif
1441 endif
1442 if(lrcore)then !save other mothers for same core
1443 lrcor0=.false.
1444 do i=1,maproj+matarg
1445 if(isthep2(i).gt.0.and.jmohep2(2,i).gt.0)then
1446 nhepio=nhepio+1
1447 nio=nio+1
1448 idhep(nhepio)=idhep2(i)
1449 phep(1,nhepio)=phep2(1,i)
1450 phep(2,nhepio)=phep2(2,i)
1451 phep(3,nhepio)=phep2(3,i)
1452 phep(4,nhepio)=phep2(4,i)
1453 phep(5,nhepio)=phep2(5,i)
1454 isthep(nhepio)=4
1455 vhep(1,nhepio)=vhep2(1,i)
1456 vhep(2,nhepio)=vhep2(2,i)
1457 vhep(3,nhepio)=vhep2(3,i)
1458 vhep(4,nhepio)=vhep2(4,i)
1459 jmohep(1,nhepio)=-1
1460 jmohep(2,nhepio)=-1
1461 isthep2(i)=-isthep2(i)
1462 iepo2hep(i)=nhepio
1463 ihep2epo2(i)=-nhepio
1464 endif
1465 enddo
1466 endif
1467 nhep=nhep+1
1468 idhep(nhep)=idhep2(k)
1469 phep(1,nhep)=phep2(1,k)
1470 phep(2,nhep)=phep2(2,k)
1471 phep(3,nhep)=phep2(3,k)
1472 phep(4,nhep)=phep2(4,k)
1473 phep(5,nhep)=phep2(5,k)
1474 isthep(nhep)=isthep2(k)
1475 vhep(1,nhep)=vhep2(1,k)
1476 vhep(2,nhep)=vhep2(2,k)
1477 vhep(3,nhep)=vhep2(3,k)
1478 vhep(4,nhep)=vhep2(4,k)
1479 jdahep(1,nhep)=0
1480 if(jdahep2(1,k).gt.0)jdahep(1,nhep)=-ihep2epo2(jdahep2(1,k))
1481 jdahep(2,nhep)=0
1482 if(jdahep2(2,k).gt.0)jdahep(2,nhep)=-ihep2epo2(jdahep2(2,k))
1483 jmohep(1,nhep)=nhepi0
1484 jmohep(2,nhep)=nhepi0+nio
1485 isthep2(k)=-isthep2(k)
1486 if(ihep2epo2(k).le.0)then
1487 ihep2epo2(k)=-nhep
1488 else !for nuclear fragments
1489 ihep2epo(nhep)=ihep2epo2(k)
1490 if(ihep2epo(nhep).gt.0)iepo2hep(ihep2epo(nhep))=nhep
1491 endif
1492
1493 endif
1494
1495 enddo
1496
1497 if(nhepio.ge.nhepi0)then
1498 do i=nhepi0,nhepi0+nio
1499 jdahep(1,i)=nhep0+1
1500 jdahep(2,i)=nhep
1501 enddo
1502 endif
1503
1504 endif
1505
1506 enddo
1507
1508
1509
1510
1511 do k=maproj+matarg+1,nhep2
1512
1513 if(isthep2(k).gt.0)then
1514
1515
1516 nhep0=nhep+1
1517 nhepi0=nhepio+1
1518 if(jmohep2(1,k).gt.0.and.jmohep2(1,k).le.maproj+matarg)then
1519
1520 do j=1,maproj+matarg
1521
1522 if(isthep2(j).gt.0.and.jdahep2(1,j).eq.ihep2epo2(k))then
1523 nhepio=nhepio+1
1524 idhep(nhepio)=idhep2(j)
1525 phep(1,nhepio)=phep2(1,j)
1526 phep(2,nhepio)=phep2(2,j)
1527 phep(3,nhepio)=phep2(3,j)
1528 phep(4,nhepio)=phep2(4,j)
1529 phep(5,nhepio)=phep2(5,j)
1530 isthep(nhepio)=4
1531 vhep(1,nhepio)=vhep2(1,j)
1532 vhep(2,nhepio)=vhep2(2,j)
1533 vhep(3,nhepio)=vhep2(3,j)
1534 vhep(4,nhepio)=vhep2(4,j)
1535 jmohep(1,nhepio)=-1
1536 jmohep(2,nhepio)=-1
1537 jdahep(1,nhepio)=0
1538 if(jdahep2(1,j).gt.0)jdahep(1,nhepio)=-jdahep2(1,j)
1539 jdahep(2,nhepio)=0
1540 if(jdahep2(2,j).gt.0)jdahep(2,nhepio)=-jdahep2(2,j)
1541 isthep2(j)=-isthep2(j)
1542 iepo2hep(j)=nhepio
1543 ihep2epo(nhepio)=j
1544 endif
1545
1546 enddo
1547
1548 endif
1549
1550 nhep=nhep+1
1551 idhep(nhep)=idhep2(k)
1552 phep(1,nhep)=phep2(1,k)
1553 phep(2,nhep)=phep2(2,k)
1554 phep(3,nhep)=phep2(3,k)
1555 phep(4,nhep)=phep2(4,k)
1556 phep(5,nhep)=phep2(5,k)
1557 isthep(nhep)=isthep2(k)
1558 vhep(1,nhep)=vhep2(1,k)
1559 vhep(2,nhep)=vhep2(2,k)
1560 vhep(3,nhep)=vhep2(3,k)
1561 vhep(4,nhep)=vhep2(4,k)
1562 jdahep(1,nhep)=0
1563 if(jdahep2(1,k).gt.0)jdahep(1,nhep)=-ihep2epo2(jdahep2(1,k))
1564 jdahep(2,nhep)=0
1565 if(jdahep2(2,k).gt.0)jdahep(2,nhep)=-ihep2epo2(jdahep2(2,k))
1566 ihep2epo(nhep)=ihep2epo2(k)
1567 if(ihep2epo(nhep).gt.0)iepo2hep(ihep2epo(nhep))=nhep
1568 if(nhepio.lt.nhepi0)then
1569 if(jmohep2(1,k).gt.0)then
1570 if(ihep2epo2(jmohep2(1,k)).le.0)then
1571 jmohep(1,nhep)=-ihep2epo2(jmohep2(1,k))
1572 else
1573 jmohep(1,nhep)=iepo2hep(ihep2epo2(jmohep2(1,k)))
1574 endif
1575 else
1576 jmohep(1,nhep)=0
1577 endif
1578 if(jmohep2(2,k).gt.0)then
1579 if(ihep2epo2(jmohep2(2,k)).le.0)then
1580 jmohep(2,nhep)=-ihep2epo2(jmohep2(2,k))
1581 else
1582 jmohep(2,nhep)=iepo2hep(ihep2epo2(jmohep2(2,k)))
1583 endif
1584 else
1585 jmohep(2,nhep)=0
1586 endif
1587 else !for nuclear fragments
1588 jmohep(1,nhep)=nhepi0
1589 jmohep(2,nhep)=nhepio
1590 endif
1591 isthep2(k)=-isthep2(k)
1592
1593 endif
1594
1595 enddo
1596
1597 if(nhep.ne.nhep2.or.nhepio.ne.maproj+matarg)then
1598 print *,'Warning : number of particles changed after copy'
1599 nrem1=0
1600 do k=1,nhep2
1601 if(isthep2(k).eq.-4)then
1602 nrem1=nrem1+1
1603 endif
1604 if(isthep2(k).gt.0)
1605 & print *,' ',k,idhep2(k),jmohep2(1,k),isthep2(k) jm1hep=iepo2hep(io)
1606
1607 & ,'from',ihep2epo2(k)
1608 enddo
1609 print *,' ',nhep2,'->',nhep
1610 nrem2=0
1611 do k=1,nhep
1612 if(isthep(k).eq.4)then
1613 nrem2=nrem2+1
1614 endif
1615
1616 enddo
1617 print *,' Particle list not consistent, skip event !'
1618 print *,' ',nrem1,'->',nrem2
1619 goto 10000
1620 endif
1621
1622
1623
1624 do j=1,nhep
1625
1626 i=ihep2epo(j)
1627
1628 if(jdahep(1,j).lt.0)then
1629
1630 jdahep(1,j)=iepo2hep(-jdahep(1,j))
1631 if(jdahep(2,j).lt.0)jdahep(2,j)=iepo2hep(-jdahep(2,j))
1632
1633
1634 elseif(i.gt.0.and.jdahep(1,j).eq.0)then
1635
1636
1637 if(ifrptl(1,i).gt.0)then
1638 jdahep(1,j)=iepo2hep(ifrptl(1,i))
1639 else
1640 jdahep(1,j)=0
1641 endif
1642
1643 if(jdahep(2,j).eq.0)then
1644
1645 if(ifrptl(2,i).gt.0)then
1646 jdahep(2,j)=iepo2hep(ifrptl(2,i))
1647 else
1648 jdahep(2,j)=0
1649 endif
1650 endif
1651
1652 endif
1653
1654
1655
1656
1657
1658
1659 enddo
1660
1661
1662 9999 return
1663 10000 nhep=0
1664 goto 9999
1665 end
1666
1667
1668 subroutine lhestore(n)
1669
1670
1671
1672
1673
1674
1675
1676
1677 include 'epos.inc'
1678
1679
1680 INTEGER MAXNUP
1681 PARAMETER (MAXNUP=50000) !extend array for file production
1682
1683 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
1684 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
1685 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
1686 &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
1687 &VTIMUP(MAXNUP),SPINUP(MAXNUP)
1688 SAVE /HEPEUP/
1689
1690
1691 integer iepo2hep(mxptl)
1692
1693
1694
1695 nhep=0
1696 do i=1,nptl
1697 if(istptl(i).le.istmax.and.abs(idptl(i)).le.10000)nhep=nhep+1
1698 enddo
1699 if(nhep.gt.MAXNUP)then
1700 print *,'Warning : produced number of particles is too high'
1701 print *,' event is not stored'
1702 goto 1000
1703 endif
1704
1705
1706 NUP=nhep !number of particles
1707 IDPRUP=nint(abs(typevt)) !type of event (ND,DD,CD,SD)
1708 XWGTUP=1d0 !weight of event
1709 SCALUP=-1d0 !scale for PDF (not used)
1710 AQEDUP=-1d0 !alpha QED (not relevant)
1711 AQCDUP=-1d0 !alpha QCD (not relevant)
1712
1713
1714
1715 write(ifdt,'(A)') '<event>'
1716 write(ifdt,*)NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP
1717 nhep=0
1718 DO 220 i=1,nptl
1719
1720 if(istptl(i).le.istmax.and.abs(idptl(i)).le.10000)then !store events with istptl < istmax
1721
1722 nhep=nhep+1
1723
1724
1725 idpdg=idtrafo('nxs','pdg',idptl(i))
1726 if(idpdg.eq.99)idpdg=0 !unknown particle
1727 iepo2hep(i)=nhep
1728
1729 IDUP(nhep)=idpdg
1730 if(iorptl(i).lt.0)then
1731 ISTUP(nhep)=-9 !incoming particle
1732 else
1733 ISTUP(nhep)=min(3,istptl(i)+1) !in LHEF:1=final, 2=decayed, 3=intermediate state
1734 endif
1735 if(iorptl(i).gt.0)then
1736 MOTHUP(1,nhep)=iepo2hep(iorptl(i))
1737 else
1738 MOTHUP(1,nhep)=0
1739 endif
1740
1741 if(jorptl(i).gt.0)then
1742 MOTHUP(2,nhep)=iepo2hep(jorptl(i))
1743 else
1744 MOTHUP(2,nhep)=-1
1745 endif
1746 ICOLUP(1,nhep)=0 !color flow
1747 ICOLUP(2,nhep)=0 !color flow
1748 do J=1,5 !particle momentum (GeV/c)
1749 PUP(J,nhep)=dble(pptl(J,i))
1750 enddo
1751 VTIMUP(nhep)=(dble(tivptl(2,i))-dble(tivptl(1,i)))*1d-12 !life time c*tau in mm
1752 if(VTIMUP(nhep).gt.dble(ainfin)
1753 & .or.VTIMUP(nhep).ne.VTIMUP(nhep))then
1754 write(ifch,*)'ici',VTIMUP(nhep),tivptl(2,i),tivptl(1,i)
1755 & ,i,nptl
1756 VTIMUP(nhep)=ainfin
1757 call utstop("aie&")
1758 endif
1759 SPINUP(nhep)=9 !polarization (not known)
1760 write(ifdt,*)IDUP(nhep),ISTUP(nhep),
1761 & MOTHUP(1,nhep),MOTHUP(2,nhep),ICOLUP(1,nhep),ICOLUP(2,nhep),
1762 & (PUP(J,nhep),J=1,5),VTIMUP(nhep),SPINUP(nhep)
1763 endif
1764 220 CONTINUE
1765
1766
1767 write(ifdt,*)'#geometry',bimevt,phievt
1768
1769 write(ifdt,'(A)') '</event>'
1770
1771 if(n.eq.nevent)then
1772
1773 write(ifdt,'(A)') '</LesHouchesEvents>'
1774 write(ifdt,'(A)') ' '
1775 endif
1776
1777 1000 continue
1778
1779 return
1780 end
1781
1782
1783
1784 subroutine ustore
1785
1786
1787
1788
1789
1790 include 'epos.inc'
1791 integer iepo2hep(mxptl)
1792
1793
1794
1795
1796 nptevt=0
1797 do i=1,nptl
1798 iepo2hep(i)=-1 !initialize hep index to epos index
1799 if(istptl(i).le.istmax)nptevt=nptevt+1
1800 enddo
1801
1802
1803
1804
1805
1806
1807 nevhep=nrevt
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825 nhep=0
1826 do i=1,nptl
1827
1828 if(istptl(i).le.istmax.or.i.le.maproj+matarg)then !store events with istptl < istmax
1829
1830 nhep=nhep+1
1831 if(nhep.gt.nmxhep)then
1832 print *,'Warning : produced number of particles is too high'
1833 print *,' Particle list is truncated'
1834 goto 1000
1835 endif
1836
1837
1838
1839
1840
1841 idpdg=idtrafo('nxs','pdg',idptl(i))
1842 if(idpdg.ne.99)then
1843 idhep(nhep)=idpdg
1844 iepo2hep(i)=nhep
1845 else
1846 print *,'Skip particle',i,idptl(i)
1847 nhep=nhep-1
1848 goto 100
1849 endif
1850
1851 phep(1,nhep)=dble(pptl(1,i))
1852
1853 phep(2,nhep)=dble(pptl(2,i))
1854
1855 phep(3,nhep)=dble(pptl(3,i))
1856
1857 phep(4,nhep)=dble(pptl(4,i))
1858
1859 phep(5,nhep)=dble(pptl(5,i))
1860
1861 if(iorptl(i).gt.0)then
1862 jmohep(1,nhep)=iepo2hep(iorptl(i))
1863 else
1864 jmohep(1,nhep)=-1
1865 endif
1866
1867 if(jorptl(i).gt.0)then
1868 jmohep(2,nhep)=iepo2hep(jorptl(i))
1869 else
1870 jmohep(2,nhep)=-1
1871 endif
1872
1873 jdahep(1,nhep)=0 !need a second loop to calculated proper indice
1874
1875 jdahep(2,nhep)=0 !need a second loop to calculated proper indice
1876
1877 isthep(nhep)=min(2,istptl(i)+1) !in hep:1=final, 2=decayed
1878 if(i.le.maproj+matarg)isthep(nhep)=4 !beam particles
1879
1880
1881 vhep(1,nhep)=xorptl(1,i)*1e-12 !conversion to mm
1882
1883 vhep(2,nhep)=xorptl(2,i)*1e-12 !conversion to mm
1884
1885 vhep(3,nhep)=xorptl(3,i)*1e-12 !conversion to mm
1886
1887 vhep(4,nhep)=xorptl(4,i)*1E-12 !conversion to mm/c
1888
1889
1890
1891 100 continue
1892
1893 endif
1894 enddo
1895
1896 1000 continue
1897
1898 if(istmax.ge.1)then
1899 nhep=0
1900 do i=1,nptl
1901
1902 if(istptl(i).le.istmax)then !store events with istptl < istmax
1903
1904 nhep=nhep+1
1905 if(nhep.gt.nmxhep)return
1906
1907
1908 if(ifrptl(1,i).gt.0)then
1909 jdahep(1,nhep)=iepo2hep(ifrptl(1,i))
1910 else
1911 jdahep(1,nhep)=0
1912 endif
1913
1914 if(ifrptl(2,i).gt.0)then
1915 jdahep(2,nhep)=iepo2hep(ifrptl(2,i))
1916 else
1917 jdahep(2,nhep)=0
1918 endif
1919
1920 endif
1921 enddo
1922 endif
1923
1924
1925 return
1926 end
1927
1928
1929 subroutine bstora
1930
1931
1932
1933
1934 include 'epos.inc'
1935
1936 INTEGER MAXPUP
1937 PARAMETER (MAXPUP=100)
1938 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
1939 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
1940 COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
1941 &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
1942 &LPRUP(MAXPUP)
1943 SAVE /HEPRUP/
1944 common/photrans/phoele(4),ebeam
1945
1946 common/record/maxrec(2),irecty(30,2)
1947 character code*8,version*8,frame*4,ldum*888
1948
1949 code='EPOS '
1950 if(iLHC.eq.1)code= 'EPOSLHC '
1951 if(model.eq.2)code='QGSJET01'
1952 if(model.eq.3)code='GHEISHA '
1953 if(model.eq.4)code='PYTHIA '
1954 if(model.eq.5)code='HIJING '
1955 if(model.eq.6)code='SIBYLL '
1956 if(model.eq.7.or.model.eq.11)code='QGSJETII'
1957 if(model.eq.8)code='PHOJET '
1958 if(model.eq.9)code='FLUKA '
1959 write(version,'(f5.2,3x)')iversn/100.
1960
1961 if(iframe.eq. 1)frame='ttcm'
1962 if(iframe.eq.11)frame='nncm'
1963 if(iframe.eq.12)frame='targ'
1964 if(iframe.eq.21)frame='gncm'
1965 if(iframe.eq.22)frame='lncm'
1966 ntest=1
1967 if (istore.eq.2) then ! OSC1997A
1968 if(iappl.eq.3)then
1969 read(ifdt,'(A)')ldum
1970 read(ifdt,'(A)')ldum
1971 read(ifdt,'(A)')ldum
1972 else
1973 write (ifdt,'(a)') 'OSC1997A'
1974 write (ifdt,'(a)') 'final_id_p_x'
1975 write(ifdt,100) code,version
1976 * ,maproj,laproj,matarg,latarg,frame,engy,ntest
1977 100 format(2(a8,' '),'(',i3,',',i3,')+(',i3,',',i3,')',
1978 * ' ',a4,' ',e10.4,' ',i8)
1979 maxrec(1)=4
1980 irecty(1,1)=1 !nevt
1981 irecty(2,1)=2
1982 irecty(3,1)=3
1983 irecty(4,1)=4
1984 maxrec(2)=11
1985 irecty(1,2)=1 !nr
1986 irecty(2,2)=2 !id
1987 irecty(3,2)=3 !px
1988 irecty(4,2)=4 !py
1989 irecty(5,2)=5 !pz
1990 irecty(6,2)=6 !E
1991 irecty(7,2)=7 !M
1992 irecty(8,2)=11 !x
1993 irecty(9,2)=12 !y
1994 irecty(10,2)=13 !z
1995 irecty(11,2)=14 !t
1996 endif
1997 elseif(istore.eq.3) then
1998 if(iappl.eq.3)then
1999 read(ifdt,'(A)')ldum
2000 read(ifdt,'(A)')ldum
2001 read(ifdt,'(A)')ldum
2002 read(ifdt,'(A)')ldum
2003 else
2004 201 format('# ',a)
2005 write (ifdt,201) 'OSC1999A'
2006 if(istmax.eq.0) then
2007 write (ifdt,201) 'final_id_p_x'
2008 elseif(istmax.ge.2) then
2009 write (ifdt,201) 'full_event_history'
2010 endif
2011 202 format('# ',a8,' ',a8)
2012 write(ifdt,202) code,version !3rd line
2013 203 format('# (',i3,',',i3,')+(',i3,',',i3,')',
2014 * ' ',a4,' ',e10.4,' ',i8)
2015 write(ifdt,203) maproj,laproj,matarg,latarg,frame,engy,ntest
2016 endif
2017 maxrec(1)=5
2018 irecty(1,1)=2 !nevt
2019 irecty(2,1)=0 !zero
2020 irecty(3,1)=1 !additional information
2021 irecty(4,1)=3 !additional information
2022 irecty(5,1)=4 !additional information
2023 maxrec(2)=12
2024 irecty(1,2)=1 !nr
2025 irecty(2,2)=2 !id
2026 irecty(3,2)=10 !ist
2027 irecty(4,2)=3 !px
2028 irecty(5,2)=4 !py
2029 irecty(6,2)=5 !pz
2030 irecty(7,2)=6 !E
2031 irecty(8,2)=7 !M
2032 irecty(9,2)=11 !x
2033 irecty(10,2)=12 !y
2034 irecty(11,2)=13 !z
2035 irecty(12,2)=14 !t
2036 ! nin nout [optional information]
2037 ! ipart id ist px py pz p0 mass x y z t [optional information]
2038 elseif(istore.eq.4)then
2039
2040
2041 if(kdtopen.eq.1)close(ifdt)
2042 kdtopen=1
2043 fndt(nfndt-4:nfndt)=".lhe "
2044 nfndt=nfndt-1
2045 if(iappl.eq.3)then
2046 open(unit=ifdt,file=fndt(1:nfndt),status='old')
2047 else
2048 open(unit=ifdt,file=fndt(1:nfndt),status='unknown')
2049
2050 write(ifdt,'(A)') '<LesHouchesEvents version="1.0">'
2051 write(ifdt,'(A)') '<!--'
2052 write(ifdt,'(A,A8,A,A8)') '# File generated with ',code,' '
2053 * ,version
2054 write(ifdt,'(A,I9)')'# Total number of min. bias events : '
2055 * ,nevent
2056 write(ifdt,'(A)') '# 4 types of subprocess are defined : '
2057 write(ifdt,'(A)')
2058 * '# -> 1 : Non Diffractive events AB-->X'
2059 write(ifdt,'(A)')
2060 * '# -> 2 : Double Diffractive events AB-->XX'
2061 write(ifdt,'(A)')
2062 * '# -> 3 : Central Diffractive events AB-->AXB'
2063 write(ifdt,'(A)')
2064 * '# -> 4 : Single Diffractive events AB-->XB or AB-->AX'
2065 write(ifdt,'(A)')
2066 * '#geometry gives impact parameter (fm) and phi (rad) of events'
2067 write(ifdt,'(A)') '-->'
2068
2069
2070 IDBMUP(1)=idtrafo('nxs','pdg',idproj) !projectile
2071 IDBMUP(2)=idtrafo('nxs','pdg',idtarg) !target
2072 if(noebin.lt.0)then
2073 EBMUP(1)=dble(elepti) !energy beam proj
2074 EBMUP(2)=dble(ebeam) !energy beam targ
2075 PDFGUP(1)=-1d0 !PDFlib group code for proj PDF (lepton)
2076 PDFGUP(2)=1d0 !PDFlib group code for targ PDF (user defined)
2077 PDFSUP(1)=-1d0 !PDFlib set code for proj PDF (lepton)
2078 PDFSUP(2)=1d0 !PDFlib set code for targ PDF (user defined)
2079 else
2080 EBMUP(1)=dble(0.5*engy) !energy beam proj
2081 EBMUP(2)=dble(0.5*engy) !energy beam targ
2082 if(iappl.eq.6)then
2083 PDFGUP(1)=-1d0 !PDFlib group code for proj PDF (lepton)
2084 PDFGUP(2)=-1d0 !PDFlib group code for targ PDF (lepton)
2085 PDFSUP(1)=-1d0 !PDFlib set code for proj PDF (lepton)
2086 PDFSUP(2)=-1d0 !PDFlib set code for targ PDF (lepton)
2087 elseif(iappl.eq.7)then
2088 PDFGUP(1)=-1d0 !PDFlib group code for proj PDF (lepton)
2089 PDFGUP(2)=1d0 !PDFlib group code for targ PDF (user defined)
2090 PDFSUP(1)=-1d0 !PDFlib set code for proj PDF (lepton)
2091 PDFSUP(2)=1d0 !PDFlib set code for targ PDF (user defined)
2092 else
2093 PDFGUP(1)=1d0 !PDFlib group code for proj PDF (user defined)
2094 PDFGUP(2)=1d0 !PDFlib group code for targ PDF (user defined)
2095 PDFSUP(1)=1d0 !PDFlib set code for proj PDF (user defined)
2096 PDFSUP(2)=1d0 !PDFlib set code for targ PDF (user defined)
2097 endif
2098 endif
2099 IDWTUP=3 !weight=1 for all events
2100 NPRUP=4 !number of subprocess (ND,DD,CD,SD)
2101 IPR=1 !subprocesses (store non diffractive events)
2102 XSECUP(IPR)=dble(sigcut)*1d9 !cross section in pb
2103 XERRUP(IPR)=0d0 !statistical error
2104 XMAXUP(IPR)=1d0 !weight
2105 LPRUP(IPR)=1 !ND event (typevt=1)
2106 IPR=2 !subprocesses (store double diffractive events)
2107 XSECUP(IPR)=dble(sigdd)*1d9 !cross section in pb
2108 XERRUP(IPR)=0d0 !statistical error
2109 XMAXUP(IPR)=1d0 !weight
2110 LPRUP(IPR)=2 !DD event (typevt=2)
2111 IPR=3 !subprocesses (store single diffractive events)
2112 XSECUP(IPR)=dble(sigdif-sigdd-sigsd)*1d9 !cross section in pb
2113 XERRUP(IPR)=0d0 !statistical error
2114 XMAXUP(IPR)=1d0 !weight
2115 LPRUP(IPR)=3 !CD event (typevt=3)
2116 IPR=4 !subprocesses (store single diffractive events)
2117 XSECUP(IPR)=dble(sigsd)*1d9 !cross section in pb
2118 XERRUP(IPR)=0d0 !statistical error
2119 XMAXUP(IPR)=1d0 !weight
2120 LPRUP(IPR)=4 !SD event (typevt=4)
2121
2122
2123
2124 write(ifdt,'(A)') '<init>'
2125 write(ifdt,*) IDBMUP(1),IDBMUP(2),EBMUP(1),EBMUP(2)
2126 & ,PDFGUP(1),PDFGUP(2),PDFSUP(1),PDFSUP(2),IDWTUP,NPRUP
2127 DO 120 IPR=1,NPRUP
2128 write(ifdt,*) XSECUP(IPR),XERRUP(IPR),XMAXUP(IPR),LPRUP(IPR)
2129 120 CONTINUE
2130 write(ifdt,'(A)') '</init>'
2131 endif
2132
2133 endif
2134
2135 end
2136
2137
2138 subroutine bstore
2139
2140
2141
2142
2143
2144 include 'epos.inc'
2145 common/record/maxrec(2),irecty(30,2)
2146 common/dimensi/k2(100)
2147
2148 nptevt=0
2149 do n=1,nptl
2150 iok=1 !idcode simple
2151 if(istptl(n).gt.istmax
2152 & .or.(ioidch.eq.2.and.idptl(n).gt.10000))then
2153 iok=0
2154 endif
2155 if (iok.eq.1) nptevt=nptevt+1
2156 enddo
2157 11 format (i6,' ',$)
2158 12 format (e12.6,' ',$)
2159 13 format (f3.0,' ',$)
2160 do i=1,maxrec(1)
2161 l=irecty(i,1)
2162 if(l.eq.0)write(ifdt,21) 0
2163 if(l.eq.1)write(ifdt,11)nrevt
2164 if(l.eq.2)write(ifdt,11)nptevt
2165 if(l.eq.3)write(ifdt,12)bimevt
2166 if(l.eq.4)write(ifdt,12)phievt
2167 if(l.eq.5)write(ifdt,11)kolevt
2168 if(l.eq.6)write(ifdt,12)pmxevt
2169 if(l.eq.7)write(ifdt,12)egyevt
2170 if(l.eq.8)write(ifdt,11)npjevt
2171 if(l.eq.9)write(ifdt,11)ntgevt
2172 if(l.eq.10)write(ifdt,11)npnevt
2173 if(l.eq.11)write(ifdt,11)nppevt
2174 if(l.eq.12)write(ifdt,11)ntnevt
2175 if(l.eq.13)write(ifdt,11)ntpevt
2176 if(l.eq.14)write(ifdt,11)jpnevt
2177 if(l.eq.15)write(ifdt,11)jppevt
2178 if(l.eq.16)write(ifdt,11)jtnevt
2179 if(l.eq.17)write(ifdt,11)jtpevt
2180 if(l.eq.20)write(ifdt,12)amproj
2181 if(l.eq.21)write(ifdt,12)amtarg
2182 if(l.eq.22)write(ifdt,12)qsqevt
2183 if(l.eq.23)write(ifdt,12)xbjevt
2184 if(l.eq.24)write(ifdt,13)typevt
2185 enddo
2186 write (ifdt,*) !RETURN
2187 21 format (i6,' ',$)
2188 22 format (e12.6,' ',$)
2189 23 format (i10,' ',$)
2190 do n=1,nptl
2191 iok=1 !idcode simple
2192 if(istptl(n).gt.istmax
2193 & .or.(ioidch.eq.2.and.idptl(n).gt.10000))then
2194 iok=0
2195 endif
2196 if (iok.eq.1) then
2197 id=idptl(n)
2198 if(istore.eq.2.or.ioidch.eq.2)then
2199 id=idtrafo('nxs','pdg',idptl(n))
2200 endif
2201 do i=1,maxrec(2)
2202 l=irecty(i,2)
2203 if(l.eq.0)write(ifdt,21) 0
2204 if(l.eq.1)write(ifdt,21) n
2205 if(l.eq.2)write(ifdt,23) id
2206 if(l.eq.3.or.l.eq.17)write(ifdt,22) pptl(1,n)
2207 if(l.eq.4.or.l.eq.17)write(ifdt,22) pptl(2,n)
2208 if(l.eq.5.or.l.eq.17)write(ifdt,22) pptl(3,n)
2209 if(l.eq.6.or.l.eq.17)write(ifdt,22) pptl(4,n)
2210 if(l.eq.7.or.l.eq.17)write(ifdt,22) pptl(5,n)
2211 if(l.eq.8)write(ifdt,21) iorptl(n)
2212 if(l.eq.9)write(ifdt,21) jorptl(n)
2213 if(l.eq.10)write(ifdt,21) istptl(n)
2214 if(l.eq.11.or.l.eq.18)write(ifdt,22) xorptl(1,n)
2215 if(l.eq.12.or.l.eq.18)write(ifdt,22) xorptl(2,n)
2216 if(l.eq.13.or.l.eq.18)write(ifdt,22) xorptl(3,n)
2217 if(l.eq.14.or.l.eq.18)write(ifdt,22) xorptl(4,n)
2218 if(l.eq.19)write(ifdt,22) dezptl(n)
2219 if(l.eq.21)write(ifdt,21) ifrptl(1,n)
2220 if(l.eq.22)write(ifdt,21) ifrptl(2,n)
2221 if(l.eq.23)write(ifdt,21) ityptl(n)
2222 if(l.eq.15) then
2223 if(iorptl(n).gt.0)then
2224 write(ifdt,23) idptl(iorptl(n))
2225 else
2226 write(ifdt,23) 0
2227 endif
2228 endif
2229 if(l.eq.16) then
2230 if(jorptl(n).gt.0)then
2231 write(ifdt,23) idptl(jorptl(n))
2232 else
2233 write(ifdt,23) 0
2234 endif
2235 endif
2236 enddo
2237 write (ifdt,*) !RETURN
2238 endif
2239 enddo
2240 return
2241 end
2242
2243
2244
2245 subroutine bread
2246
2247
2248
2249
2250
2251 include 'epos.inc'
2252 common/record/maxrec(2),irecty(30,2)
2253 character*255 line
2254 dimension inptl(mxptl)
2255 data ichkfile/0/
2256 save ichkfile
2257 logical info
2258
2259 INTEGER MAXNUP
2260 PARAMETER (MAXNUP=50000) !extend array for file production
2261
2262 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
2263 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
2264 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
2265 &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
2266 &VTIMUP(MAXNUP),SPINUP(MAXNUP)
2267 SAVE /HEPEUP/
2268
2269 if(istore.eq.-1.or.iappl.eq.-1)then
2270
2271 ifinp=ifdt
2272 if(ichkfile.eq.0)then
2273 if(iappl.eq.-1)then
2274 inquire(file=fnin(1:nfnin),exist=info)
2275 if(info)then
2276 open(unit=ifin,file=fnin(1:nfnin),status='old')
2277 ifinp=ifin
2278 else
2279 call utstop('Cannot open file for conversion !&')
2280 endif
2281 endif
2282 endif
2283
2284 read(ifinp,*,end=999)nptevt,bimevt,phievt,kolevt,pmxevt,egyevt
2285 * ,npjevt,ntgevt,qsqevt,typevt
2286 if(nptevt.eq.0.or.nptevt.gt.mxptl)then
2287 print *,'sorry, '
2288 print *,'there is wrong particle number in the event record '
2289 stop
2290 endif
2291 nptl=0
2292 do n=1,nptevt
2293 nptl=nptl+1
2294 read(ifinp,*)nidp,id,pp1,pp2,pp3,pp4,pp5,io,jo,is,it
2295 * ,xo1,xo2,xo3,xo4,ifr1,ifr2,dez
2296
2297 do while(nptl.lt.nidp)
2298 idptl(nptl)=0
2299 pptl(1,nptl)=0.
2300 pptl(2,nptl)=0.
2301 pptl(3,nptl)=0.
2302 pptl(4,nptl)=0.
2303 pptl(5,nptl)=0.
2304 iorptl(nptl)=0
2305 jorptl(nptl)=0
2306 istptl(nptl)=5
2307 ityptl(nptl)=0
2308 xorptl(1,nptl)=0.
2309 xorptl(2,nptl)=0.
2310 xorptl(3,nptl)=0.
2311 xorptl(4,nptl)=0.
2312 ifrptl(1,nptl)=0
2313 ifrptl(2,nptl)=0
2314 dezptl(nptl)=0
2315 nptl=nptl+1
2316 enddo
2317 idptl(nptl)=id
2318 pptl(1,nptl)=pp1
2319 pptl(2,nptl)=pp2
2320 pptl(3,nptl)=pp3
2321 pptl(4,nptl)=pp4
2322 pptl(5,nptl)=pp5
2323 iorptl(nptl)=io
2324 jorptl(nptl)=jo
2325 istptl(nptl)=is
2326 ityptl(nptl)=it
2327 xorptl(1,nptl)=xo1
2328 xorptl(2,nptl)=xo2
2329 xorptl(3,nptl)=xo3
2330 xorptl(4,nptl)=xo4
2331 ifrptl(1,nptl)=ifr1
2332 ifrptl(2,nptl)=ifr2
2333 dezptl(nptl)=dez
2334 enddo
2335
2336 elseif(istore.eq.4)then
2337
2338
2339 10 read(ifdt,'(a)',end=999)line
2340 if(line(1:7).ne."<event>")goto 10
2341
2342
2343 read(ifdt,*)NUP,typevt,XWGTUP,SCALUP,AQEDUP,AQCDUP
2344 nhep=0
2345 nptl=0
2346 DO 220 i=1,nup
2347
2348
2349 nhep=nhep+1
2350 read(ifdt,*,end=999)IDUP(nhep),ISTUP(nhep),
2351 & MOTHUP(1,nhep),MOTHUP(2,nhep),ICOLUP(1,nhep),ICOLUP(2,nhep),
2352 & (PUP(J,nhep),J=1,5),VTIMUP(nhep),SPINUP(nhep)
2353
2354 id=idtrafo('pdg','nxs',IDUP(nhep))
2355 if(id.eq.99)id=0 !unknown particle
2356 nptl=nptl+1
2357 idptl(nptl)=id
2358 if(ISTUP(nhep).eq.-9)then
2359 istptl(nptl)=1
2360 iorptl(nptl)=-1
2361 jorptl(nptl)=0
2362 else
2363 istptl(nptl)=ISTUP(nhep)-1
2364 iorptl(nptl)=MOTHUP(1,nhep)
2365 jorptl(nptl)=max(0,MOTHUP(2,nhep))
2366 endif
2367 do J=1,5 !particle momentum (GeV/c)
2368 pptl(J,nptl)=sngl(PUP(J,nhep))
2369 enddo
2370
2371 220 CONTINUE
2372
2373
2374 read(ifdt,*,end=999)line,bimevt,phievt
2375
2376 read(ifdt,*,end=999)line
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395 elseif(istore.eq.5)then
2396
2397 read(ifdt,*,end=999)nptevt,bimevt,phievt,kolevt,pmxevt,egyevt
2398 * ,npjevt,ntgevt,qsqevt,typevt
2399 if(nptevt.eq.0.or.nptevt.gt.mxptl)then
2400 print *,'sorry, '
2401 print *,'there is wrong particle number in the event record '
2402 stop
2403 endif
2404 do n=1,nptevt
2405 read(ifdt,*)nidp,idptl(n),pptl(1,n),pptl(2,n),pptl(3,n),pptl(4,n)
2406 * ,pptl(5,n),iorptl(n),jorptl(n),istptl(n),ityptl(n)
2407 * ,xorptl(1,n),xorptl(2,n),xorptl(3,n),xorptl(4,n)
2408 inptl(nidp)=n
2409 if(iorptl(n).gt.0)iorptl(n)=inptl(iorptl(n))
2410 if(jorptl(n).gt.0)jorptl(n)=inptl(jorptl(n))
2411 enddo
2412 nptl=nptevt
2413
2414 else
2415
2416 info=.false.
2417 do n=1,mxptl
2418 inptl(n)=0
2419 enddo
2420
2421 read(ifdt,'(a255)',end=1)line
2422 1 k=1
2423 nptevt=0
2424 do i=1,maxrec(1)
2425 l=irecty(i,1)
2426 if(l.eq.0)read(line(k:),'(i6)')ldummy !0
2427 if(l.eq.0) k=k+7
2428 if(l.eq.1)read(line(k:),'(i6)')ldummy !nrevt
2429 if(l.eq.1) k=k+7
2430 if(l.eq.2)read(line(k:),'(i6)')nptevt
2431 if(l.eq.2) k=k+7
2432 if(l.eq.3)read(line(k:),'(e12.6)')bimevt
2433 if(l.eq.3) k=k+13
2434 if(l.eq.4)read(line(k:),'(e12.6)')phievt
2435 if(l.eq.4) k=k+13
2436 if(l.eq.5)read(line(k:),'(i6)')kolevt
2437 if(l.eq.5) k=k+7
2438 if(l.eq.6)read(line(k:),'(e12.6)')pmxevt
2439 if(l.eq.6) k=k+13
2440 if(l.eq.7)read(line(k:),'(e12.6)')egyevt
2441 if(l.eq.7) k=k+13
2442 if(l.eq.8)read(line(k:),'(i6)')npjevt
2443 if(l.eq.8) k=k+7
2444 if(l.eq.9)read(line(k:),'(i6)')ntgevt
2445 if(l.eq.9) k=k+7
2446 if(l.eq.10)read(line(k:),'(i6)')npnevt
2447 if(l.eq.10) k=k+7
2448 if(l.eq.11)read(line(k:),'(i6)')nppevt
2449 if(l.eq.11) k=k+7
2450 if(l.eq.12)read(line(k:),'(i6)')ntnevt
2451 if(l.eq.12) k=k+7
2452 if(l.eq.13)read(line(k:),'(i6)')ntpevt
2453 if(l.eq.13) k=k+7
2454 if(l.eq.14)read(line(k:),'(i6)')jpnevt
2455 if(l.eq.14) k=k+7
2456 if(l.eq.15)read(line(k:),'(i6)')jppevt
2457 if(l.eq.15) k=k+7
2458 if(l.eq.16)read(line(k:),'(i6)')jtnevt
2459 if(l.eq.16) k=k+7
2460 if(l.eq.17)read(line(k:),'(i6)')jtpevt
2461 if(l.eq.17) k=k+7
2462 if(l.eq.20)read(line(k:),'(e12.6)')amproj
2463 if(l.eq.20) k=k+13
2464 if(l.eq.21)read(line(k:),'(e12.6)')amtarg
2465 if(l.eq.21) k=k+13
2466 if(l.eq.22)read(line(k:),'(e12.6)')qsqevt
2467 if(l.eq.22) k=k+13
2468 if(l.eq.23)read(line(k:),'(e12.6)')xbjevt
2469 if(l.eq.23) k=k+13
2470 if(l.eq.24)read(line(k:),'(f3.0)')typevt
2471 if(l.eq.24) k=k+4
2472 enddo
2473 if(nptevt.eq.0)then
2474 print *,'sorry, '
2475 print *,'there is no particle number in the event record '
2476 stop
2477 endif
2478 do n=1,nptevt
2479 read(ifdt,'(a255)',end=2)line
2480 2 k=1
2481 do i=1,maxrec(2)
2482 l=irecty(i,2)
2483 if(l.eq.0)read(line(k:),'(i6)') ldummy
2484 if(l.eq.0) k=k+7
2485 if(l.eq.1)then
2486 read(line(k:),'(i6)') nidp
2487 if(nidp.gt.0.and.nidp.le.mxptl)then
2488 info=.true.
2489 inptl(nidp)=n
2490 endif
2491 k=k+7
2492 endif
2493 if(l.eq.2)read(line(k:),'(i10)') idptl(n)
2494 if(l.eq.2) k=k+11
2495 if(l.eq.3.or.l.eq.17)read(line(k:),'(e12.6)') pptl(1,n)
2496 if(l.eq.3.or.l.eq.17) k=k+13
2497 if(l.eq.4.or.l.eq.17)read(line(k:),'(e12.6)') pptl(2,n)
2498 if(l.eq.4.or.l.eq.17) k=k+13
2499 if(l.eq.5.or.l.eq.17)read(line(k:),'(e12.6)') pptl(3,n)
2500 if(l.eq.5.or.l.eq.17) k=k+13
2501 if(l.eq.6.or.l.eq.17)read(line(k:),'(e12.6)') pptl(4,n)
2502 if(l.eq.6.or.l.eq.17) k=k+13
2503 if(l.eq.7.or.l.eq.17)read(line(k:),'(e12.6)') pptl(5,n)
2504 if(l.eq.7.or.l.eq.17) k=k+13
2505 if(l.eq.8)then
2506 read(line(k:),'(i6)') iorptl(n)
2507 k=k+7
2508 if(info.and.iorptl(n).gt.0)iorptl(n)=inptl(iorptl(n))
2509 endif
2510 if(l.eq.9)then
2511 read(line(k:),'(i6)') jorptl(n)
2512 k=k+7
2513 if(info.and.jorptl(n).gt.0)jorptl(n)=inptl(jorptl(n))
2514 endif
2515 if(l.eq.10)read(line(k:),'(i6)') istptl(n)
2516 if(l.eq.10) k=k+7
2517 if(l.eq.11.or.l.eq.18)read(line(k:),'(e12.6)')xorptl(1,n)
2518 if(l.eq.11.or.l.eq.18) k=k+13
2519 if(l.eq.12.or.l.eq.18)read(line(k:),'(e12.6)')xorptl(2,n)
2520 if(l.eq.12.or.l.eq.18) k=k+13
2521 if(l.eq.13.or.l.eq.18)read(line(k:),'(e12.6)')xorptl(3,n)
2522 if(l.eq.13.or.l.eq.18) k=k+13
2523 if(l.eq.14.or.l.eq.18)read(line(k:),'(e12.6)')xorptl(4,n)
2524 if(l.eq.14.or.l.eq.18) k=k+13
2525
2526 if(l.eq.15) k=k+7
2527
2528 if(l.eq.16) k=k+7
2529 if(l.eq.19)read(line(k:),'(e12.6)') dezptl(n)
2530 if(l.eq.19) k=k+13
2531
2532 if(l.eq.21) k=k+7
2533
2534 if(l.eq.22) k=k+7
2535 if(l.eq.23)read(line(k:),'(I6)') ityptl(n)
2536 if(l.eq.23) k=k+7
2537 enddo
2538 enddo
2539
2540 nptl=nptevt
2541
2542 endif
2543
2544 nevt=1
2545 999 continue
2546 end
2547
2548
2549 subroutine aafinal
2550
2551
2552
2553
2554
2555 include 'epos.inc'
2556 do i=1,nptl
2557 if(idptl(i).ne.0.and.istptl(i).le.1)then
2558 if( abs(tivptl(1,i)).le.ainfin
2559 . .and.abs(xorptl(1,i)).le.ainfin
2560 . .and.abs(xorptl(2,i)).le.ainfin
2561 . .and.abs(xorptl(3,i)).le.ainfin
2562 . .and.abs(xorptl(4,i)).le.ainfin
2563 . .and.pptl(5,i).le.ainfin
2564 . .and.pptl(4,i).gt.0.)then
2565
2566 t=tivptl(1,i)
2567 xorptl(1,i)=xorptl(1,i)+pptl(1,i)/pptl(4,i)*(t-xorptl(4,i))
2568 xorptl(2,i)=xorptl(2,i)+pptl(2,i)/pptl(4,i)*(t-xorptl(4,i))
2569 xorptl(3,i)=xorptl(3,i)+pptl(3,i)/pptl(4,i)*(t-xorptl(4,i))
2570 xorptl(4,i)=t
2571 else
2572 if(ish.ge.1)then
2573 if(iorptl(i).gt.0)idior=idptl(iorptl(i))
2574 write(ifmt,'(a)')
2575 . '*** warning (afinal see check file): '
2576 write(ifch,'(a,i6,i10,i10,i3,1x,7(e7.1,1x))')
2577 . '*** warning (afinal): ',
2578 . i,idptl(i),idior,ityptl(i),tivptl(1,i), pptl(4,i)
2579 . ,pptl(5,i),xorptl(1,i),xorptl(2,i),xorptl(3,i),xorptl(4,i)
2580
2581 endif
2582 tivptl(1,i)=2*ainfin
2583 tivptl(2,i)=2*ainfin
2584 xorptl(1,i)=2*ainfin
2585 xorptl(2,i)=2*ainfin
2586 xorptl(3,i)=2*ainfin
2587 xorptl(4,i)=2*ainfin
2588 endif
2589 endif
2590 enddo
2591 end
2592
2593
2594 subroutine afinal
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604 include 'epos.inc'
2605 common/geom/rmproj,rmtarg,bmax,bkmx
2606 double precision pgampr,rgampr
2607 common/cgampr/pgampr(5),rgampr(4)
2608
2609 double precision pp1,pp2,pp3,pp4,pp5
2610 logical lclean
2611
2612 call utpri('afinal',ish,ishini,4)
2613
2614 lclean=.false.
2615 nptlu=max0(nptl,nptlu)
2616
2617 if(mod(iframe,10).ne.1)then
2618 if(iframe.eq.12.or.iframe.eq.22)then !targ
2619 pp1=0d0
2620 pp2=0d0
2621 pp3=dsinh(dble(yhaha))
2622 pp4=dcosh(dble(yhaha))
2623 pp5=1d0
2624 else
2625 stop'transformation not yet defined'
2626 endif
2627 endif
2628
2629 do i=1,nptl
2630 if(idptl(i).ne.0.and.istptl(i).le.1)then
2631 if(pptl(5,i).le.ainfin
2632 . .and.pptl(4,i).gt.0.)then
2633
2634 if( abs(tivptl(1,i)).le.ainfin
2635 . .and.abs(xorptl(1,i)).le.ainfin
2636 . .and.abs(xorptl(2,i)).le.ainfin
2637 . .and.abs(xorptl(3,i)).le.ainfin
2638 . .and.abs(xorptl(4,i)).le.ainfin)then
2639
2640
2641 if(mod(iframe,10).ne.1)then
2642
2643 if(iframe.eq.12)then
2644 call utlob4(-1,pp1,pp2,pp3,pp4,pp5
2645 . ,xorptl(1,i),xorptl(2,i),xorptl(3,i),xorptl(4,i))
2646 elseif(iframe.eq.22)then
2647
2648 if(.not.((abs(iappl).eq.1.or.iappl.eq.3)
2649 * .and.i.eq.2*(maproj+matarg)+1))then
2650
2651 call utlob4(-1,pp1,pp2,pp3,pp4,pp5
2652 . ,xorptl(1,i),xorptl(2,i),xorptl(3,i),xorptl(4,i))
2653
2654 call utrot4(-1,rgampr(1),rgampr(2),rgampr(3)
2655 . ,xorptl(1,i),xorptl(2,i),xorptl(3,i))
2656
2657 call utlob4(-1,pgampr(1),pgampr(2),pgampr(3),pgampr(4)
2658 . ,pgampr(5),xorptl(1,i),xorptl(2,i),xorptl(3,i),xorptl(4,i))
2659 endif
2660 else
2661 stop'transformation not yet defined'
2662 endif
2663 endif
2664 else
2665 tivptl(1,i)=ainfin
2666 xorptl(1,i)=ainfin
2667 xorptl(2,i)=ainfin
2668 xorptl(3,i)=ainfin
2669 xorptl(4,i)=ainfin
2670 endif
2671
2672
2673 if(mod(iframe,10).ne.1)then
2674 if(iframe.eq.12)then
2675 call utlob5(-yhaha
2676 . , pptl(1,i), pptl(2,i), pptl(3,i), pptl(4,i), pptl(5,i))
2677 elseif(iframe.eq.22)then
2678
2679 if(.not.((abs(iappl).eq.1.or.iappl.eq.3)
2680 * .and.i.eq.2*(maproj+matarg)+1))then
2681
2682 call utlob5(-yhaha
2683 . , pptl(1,i), pptl(2,i), pptl(3,i), pptl(4,i), pptl(5,i))
2684
2685 call utrot4(-1,rgampr(1),rgampr(2),rgampr(3)
2686 . , pptl(1,i), pptl(2,i), pptl(3,i))
2687
2688 call utlob4(-1,pgampr(1),pgampr(2),pgampr(3),pgampr(4)
2689 . ,pgampr(5), pptl(1,i), pptl(2,i), pptl(3,i), pptl(4,i))
2690 endif
2691 endif
2692 endif
2693 elseif(model.eq.6)then
2694 lclean=.true.
2695 istptl(i)=99
2696 else
2697 call utstop("Negative energy in afinal&")
2698 endif
2699 endif
2700 enddo
2701
2702 if(lclean)then
2703 nptl0=nptl
2704 call utclea(maproj+matarg+1,nptl0)
2705 endif
2706
2707 if(ish.ge.2)then
2708 if(model.eq.1)call alistf('EPOS&')
2709 if(model.eq.2)call alistf('QGSJET01&')
2710 if(model.eq.3)call alistf('GHEISHA&')
2711 if(model.eq.4)call alistf('PYTHIA&')
2712 if(model.eq.5)call alistf('HIJING&')
2713 if(model.eq.6)call alistf('SIBYLL 2.1&')
2714 if(model.eq.7.or.model.eq.11)call alistf('QGSJET II&')
2715 if(model.eq.8)call alistf('PHOJET&')
2716 if(model.eq.9)call alistf('FLUKA&')
2717 if(model.eq.10)call alistf('URQMD&')
2718 endif
2719
2720
2721
2722
2723 if(ntevt.gt.0)then
2724 b1=bminim
2725 b2=min(bmax,bmaxim)
2726 a=pi*(b2**2-b1**2)
2727 if(iappl.eq.3.or.iappl.eq.-1)then !read
2728 ntevt=nint(float(nevent)/sigine*a*10.)
2729 anintine=float(nevent)
2730 anintdiff=anintine*sigdif/sigine
2731 anintsdif=anintine*sigsd/sigine
2732 endif
2733 sigineex=anintine/float(ntevt)*a*10
2734 sigdifex=anintdiff/float(ntevt)*a*10
2735 sigsdex=anintsdif/float(ntevt)*a*10
2736 endif
2737
2738
2739 if(imihis.eq.1)call wimi
2740 if(imihis.eq.1.and.nrevt.eq.nevent)call wimino
2741 if(isphis.eq.1)call xspace(1)
2742 if(iclhis.eq.1)call wclu
2743 if(iclhis.eq.1.and.nrevt.eq.nevent)call wclufi
2744 if(iwtime.eq.1)call wtime(1)
2745 if(iwtime.eq.1.and.nrevt.eq.nevent)call wtime(2)
2746
2747 if(ish.ge.8)call alistc('afinal&',1,nptl)
2748
2749 call utprix('afinal',ish,ishini,4)
2750 return
2751 end
2752
2753
2754 subroutine bfinal
2755
2756 include 'epos.inc'
2757 if(jerr(1).gt.4.and.jerr(1).gt.0.01*nevent)then
2758 write(ifch,'(3x,70a1)')('#',i=1,70)
2759 write(ifch,*)' # number of events:',nevent
2760 write(ifch,*)' # number of (flav > 9) warnings:',jerr(1)
2761 write(ifch,*)' # (OK when happens rarely)'
2762 write(ifch,'(3x,70a1)')('#',i=1,70)
2763 endif
2764 if(jerr(3).gt.4.and.jerr(3).gt.0.01*jerr(2))then
2765 write(ifch,'(3x,70a1)')('#',i=1,70)
2766 write(ifch,*)' # number of clusters:',jerr(2)
2767 write(ifch,*)' # number of neg m^2 clusters:',jerr(3)
2768 write(ifch,*)' # (OK when happens rarely)'
2769 write(ifch,'(3x,70a1)')('#',i=1,70)
2770 endif
2771 if(jerr(5).gt.4.and.jerr(5).gt.0.01*jerr(4))then
2772 write(ifch,'(3x,70a1)')('#',i=1,70)
2773 write(ifch,*)' # number of successful remnant cluster'
2774 & ,' decays:',jerr(4)
2775 write(ifch,*)' # number of unsuccessful remnant cluster'
2776 & ,' decays:',jerr(5)
2777 write(ifch,*)' # (OK when happens rarely)'
2778 write(ifch,'(3x,70a1)')('#',i=1,70)
2779 endif
2780 if(jerr(6).gt.4.and.jerr(6).gt.0.01*nevent)then
2781 write(ifch,'(3x,70a1)')('#',i=1,70)
2782 write(ifch,*)' # number of events:',nevent
2783 write(ifch,*)' # number of low mass remnant clusters:'
2784 & ,jerr(6)
2785 write(ifch,*)' # (OK when happens rarely)'
2786 write(ifch,'(3x,70a)')('#',i=1,70)
2787 endif
2788 if(jerr(7).gt.4.and.jerr(7).gt.0.01*nevent)then
2789 write(ifch,'(3x,70a1)')('#',i=1,70)
2790 write(ifch,*)' # number of events:',nevent
2791 write(ifch,*)' # number of flav problem in SE:'
2792 & ,jerr(7)
2793 write(ifch,*)' # (OK when happens rarely)'
2794 write(ifch,'(3x,70a)')('#',i=1,70)
2795 endif
2796 if(ish.ge.1.and.jerr(8).gt.4.and.jerr(8).gt.0.01*nevent)then
2797 write(ifch,'(3x,70a1)')('#',i=1,70)
2798 write(ifch,*)' # number of events:',nevent
2799 write(ifch,*)' # number of events with all Pom lost:'
2800 & ,jerr(8)
2801 write(ifch,*)' # (OK when happens rarely)'
2802 write(ifch,'(3x,70a)')('#',i=1,70)
2803 endif
2804 end
2805
2806
2807 subroutine ainit
2808
2809 include 'epos.inc'
2810 include 'epos.incems'
2811 include 'epos.incsem'
2812 include 'epos.incpar'
2813 common/cquama/quama
2814 parameter (nptj=129)
2815 common /cptj/xptj(nptj),qptj(nptj),wptj(nptj)
2816 common/geom/rmproj,rmtarg,bmax,bkmx
2817 double precision tpro,zpro,ttar,ztar,ttaus,detap,detat!,seedp
2818 common/cttaus/tpro,zpro,ttar,ztar,ttaus,detap,detat /ctain/mtain
2819 double precision rcproj,rctarg
2820 common/geom1/rcproj,rctarg
2821 common/photrans/phoele(4),ebeam
2822
2823
2824 external sptj
2825
2826 call utpri('ainit ',ish,ishini,4)
2827
2828 inicnt=inicnt+1
2829
2830 if(inicnt.eq.1)then
2831 write(ifmt,'(a)')'initializations ...'
2832 if(isigma.eq.1.and.ionudi.ne.1)then
2833 write(ifmt,'(a)')
2834 & '##################################################'
2835 write(ifmt,'(a)')
2836 & '# Warning X section calc. not consistent with MC #'
2837 write(ifmt,'(a,i2,a,i2,a)')
2838 & '# isigma=',isigma,', ionudi=',ionudi,
2839 & ' #'
2840 write(ifmt,'(a)')
2841 & '##################################################'
2842 endif
2843 if(iLHC.eq.1)then
2844 call atitle
2845
2846 fnrj(1:nfnrj+4)=fnrj(1:nfnrj)//".lhc"
2847 nfnrj=nfnrj+4
2848 fncs(1:nfncs+4)=fncs(1:nfncs)//".lhc"
2849 nfncs=nfncs+4
2850 endif
2851 endif
2852
2853 if(noebin.ge.0)then
2854 ntevt=0
2855 if(seedi.ne.0d0)then
2856 call ranfini(seedi,iseqini,1)
2857 else
2858 stop 'seedi = 0 ... Please define it !'
2859 endif
2860 seedc=seedi
2861 if(inicnt.eq.1)then
2862 call aseedi
2863 if(seedj2.ne.0d0)then
2864 call ranfcv(seedj2)
2865 write(ifmt,'(a)')
2866 &"Random number sequence does not start at 0 ... please wait !"
2867 endif
2868 if(seedj.ne.0d0)then
2869 call ranfini(seedj,iseqsim,2)
2870 else
2871 stop 'seedi = 0 ... Please define it !'
2872 endif
2873 endif
2874 elseif(inicnt.eq.1)then !fake DIS, initialization is part of the event
2875 if(seedj.ne.0d0)then
2876 if(seedj2.ne.0d0)then
2877 call ranfcv(seedj2)
2878 write(ifmt,'(a)')
2879 & "Random number sequence does not start at 0 ... please wait !"
2880 endif
2881 call ranfini(seedj,iseqsim,2)
2882 else
2883 stop 'seedj = 0 ... Please define it !'
2884 endif
2885 call aseed(2)
2886 endif
2887
2888 if(model.ne.1.and.inicnt.eq.1)then
2889 if(model.eq.2)iversn=100 !'QGSJET01'
2890 if(model.eq.3)iversn=100 !'GHEISHA '
2891 if(model.eq.4)iversn=611 !'PYTHIA '
2892 if(model.eq.5)iversn=138 !'HIJING '
2893 if(model.eq.6)iversn=210 !'SIBYLL '
2894 if(model.eq.7)iversn=400 !'QGSJETII-04'
2895 if(model.eq.8)iversn=112 !'PHOJET '
2896 if(model.eq.9)iversn=201125 !'FLUKA '
2897 if(model.eq.11)iversn=300 !'QGSJETII-03'
2898 if(model.ne.1)iverso=iversn
2899 call IniModel(model)
2900 endif
2901
2902 if(isphis.eq.1)iframe=11 !nncm
2903 if(icinpu.ge.1)elepti=engy
2904
2905 if(iopenu.eq.2.and.ish.eq.19)stop'change this?????????' !call smassp
2906
2907 if(iappl.eq.5)then
2908 yhaha=0
2909 ypjtl=0
2910 endif
2911
2912 if(ispherio.ne.0)ndecay=1
2913 if(ispherio.ne.0)idecay=0
2914 if(ispherio.ne.0)jdecay=0
2915 if(iurqmd.ne.0)ndecay=1
2916 if(iurqmd.ne.0)idecay=0
2917 if(ifrade.eq.0)irescl=0
2918 idtarg=idtargin
2919 idproj=idprojin
2920 do 111 iii=1,4
2921 111 rexdif(iii)=abs(rexdifi(iii))
2922 if(noebin.gt.1)then
2923 engy=-1
2924 ekin=-1
2925 if(iologe.eq.1)engy=
2926 * engmin*(engmax/engmin)**((real(nrebin)-0.5)/noebin)
2927 if(iologe.eq.0.or.(iologe.lt.0.and.iologl.lt.0))engy=
2928 * engmin+(engmax-engmin)/noebin*(nrebin-0.5)
2929 if(iologl.eq.1)ekin=
2930 * engmin*(engmax/engmin)**((real(nrebin-0.5))/noebin)
2931 if(iologl.eq.0)ekin=
2932 * engmin+(engmax-engmin)/noebin*(real(nrebin)-0.5)
2933 elab=-1
2934 ecms=-1
2935 pnll=-1
2936 if(jpsi.lt.0)then
2937 11 z=0.19*sqrt(-2*alog(rangen()))*cos(2*pi*rangen())
2938 engy=abs(z)*engmax
2939 if(engy.lt.egymin)goto11
2940 endif
2941 elseif(noebin.lt.0)then !fake e-A with pi0-A for hadron production
2942 if(inicnt.eq.1)call phoGPHERAepo(0) !kinematic initialization
2943 idproj=1120 !110
2944
2945 laproj=-1
2946 maproj=1
2947 engy=-1
2948 ekin=-1
2949 elab=-1
2950 ecms=-1
2951 pnll=-1
2952 call phoGPHERAepo(1) !fix energy according to gamma energy
2953 endif
2954
2955 if(iappl.le.3)then
2956
2957 if(idtarg.eq.0)then !in case of Air target, initialize with Argon nucleus
2958 if(model.eq.6)then !no Argon in Sibyll
2959 latarg=7
2960 matarg=14
2961 else
2962 latarg=20
2963 matarg=40
2964 endif
2965 endif
2966
2967 if((idproj.ne.1120.and.(laproj.ne.-1.or.maproj.ne.1))
2968 & .or.maproj.le.0)
2969 & call utstop('Invalid projectile setup !&')
2970
2971
2972
2973
2974 if(iabs(idtarg).ne.1120.and.iabs(idtarg).ne.1220.and.idtarg.ne.0)
2975 & call utstop('Invalid target !&')
2976 if((((idtarg.eq.-1120.or.iabs(idtarg).eq.1220)
2977 & .and.(latarg.ne.-1.or.matarg.ne.1))
2978 & .and.(idtarg.ne.1120.or.latarg.lt.0))
2979 & .or.matarg.le.0)
2980 & call utstop('Invalid target setup !&')
2981
2982
2983 call idmass(idproj,amproj)
2984 call idmass(idtarg,amtarg)
2985 call idspin(idproj,ispin,jspin,istra)
2986 isoproj=sign(1,idproj)*ispin
2987 call idspin(idtarg,ispin,jspin,istra)
2988 isotarg=sign(1,idtarg)*ispin
2989 nre=0
2990 if(engy.ge.0.)nre=nre+1
2991 if(pnll.ge.0.)nre=nre+1
2992 if(elab.ge.0.)nre=nre+1
2993 if(ekin.ge.0.)nre=nre+1
2994 if(ecms.ge.0.)nre=nre+1
2995 if(nre.ne.1)stop'invalid energy definition'
2996 ifirstghe=0
2997 101 continue
2998 if(engy.gt.0.)then
2999 pnll=sqrt(amproj**2+amtarg**2)
3000 pnll=(engy-pnll)*(engy+pnll)*0.5/amtarg
3001 pnll=sqrt(max(0.,(pnll-amproj)*(pnll+amproj)))
3002
3003
3004 elab=sqrt(pnll**2+amproj**2)
3005 ekin=elab-amproj
3006 ecms=engy
3007 elseif(ecms.gt.0.)then
3008 engy=ecms
3009 pnll=sqrt(amproj**2+amtarg**2)
3010 pnll=(engy-pnll)*(engy+pnll)*0.5/amtarg
3011 pnll=sqrt(max(0.,(pnll-amproj)*(pnll+amproj)))
3012
3013
3014 elab=sqrt(pnll**2+amproj**2)
3015 ekin=elab-amproj
3016 elseif(elab.gt.0)then
3017 pnll=sqrt(max(0.,(elab-amproj)*(elab+amproj)))
3018 engy=sqrt( 2*elab*amtarg+amtarg**2+amproj**2 )
3019 ecms=engy
3020 ekin=elab-amproj
3021 elseif(pnll.gt.0)then
3022 elab=sqrt(pnll**2+amproj**2)
3023 engy=sqrt( 2*sqrt(pnll**2+amproj**2)*amtarg+amtarg**2+amproj**2 )
3024 ecms=engy
3025 ekin=elab-amproj
3026 elseif(ekin.gt.0.)then
3027 elab=ekin+amproj
3028 pnll=sqrt(max(0.,(elab-amproj)*(elab+amproj)))
3029 engy=sqrt( 2*elab*amtarg+amtarg**2+amproj**2 )
3030 ecms=engy
3031 endif
3032
3033 if(model.eq.3.and.ifirstghe.eq.0)then !det, trit and alp
3034 if(maproj.eq.2.and.laproj.eq.1)idproj=17
3035 if(maproj.eq.3.and.laproj.eq.1)idproj=18
3036 if(maproj.eq.4.and.laproj.eq.2)idproj=19
3037 if(idproj.ge.17.and.idproj.le.19)then
3038 elab=elab*maproj
3039 call idmass(idproj,amproj)
3040 maproj=1
3041 laproj=-1
3042 ifirstghe=1
3043 engy=-1
3044 ecms=-1
3045 pnll=-1
3046 ekin=-1
3047 goto 101
3048 endif
3049 endif
3050
3051 if(pnll.le.0.001)call utstop('ainit: energy too low&')
3052 if(engy.gt.egymax)call utstop('ainit: energy too high&')
3053 s=engy**2
3054 pnullx=utpcm(engy,amproj,amtarg)
3055 yhaha=alog((sqrt(pnll**2+s)+pnll)/sqrt(s))
3056 ypjtl=alog((sqrt(pnll**2+amproj**2)+pnll)/amproj)
3057 if(noebin.lt.0)then
3058 pnll=sqrt(max(0.,(ebeam-amtarg)*(ebeam+amtarg))) !in the lab system (not in the gamma-p system)
3059 ecms=2.*sqrt(ebeam*elepti) !for plots
3060 endif
3061
3062 elseif(iappl.eq.7)then
3063
3064 call idmass(idproj,amproj)
3065 if(elab.gt.0)then
3066 pnll=sqrt(max(0.,elab**2-amproj**2))
3067 engy=amproj
3068 ecms=engy
3069 ekin=elab-amproj
3070 elseif(pnll.gt.0)then
3071 elab=sqrt(pnll**2+amproj**2)
3072 engy=amproj
3073 ecms=engy
3074 ekin=elab-amproj
3075 elseif(ekin.gt.0.)then
3076 elab=ekin+amproj
3077 pnll=sqrt(max(0.,elab**2-amproj**2))
3078 engy=amproj
3079 ecms=engy
3080 else
3081 engy=amproj
3082 ecms=amproj
3083 elab=0.
3084 pnll=0.
3085 ekin=0.
3086 endif
3087
3088 pnullx=0.
3089 ypjtl=alog((sqrt(pnll**2+amproj**2)+pnll)/amproj)
3090 yhaha=ypjtl
3091
3092 elseif(engy.gt.0.)then
3093
3094 ecms=engy
3095
3096
3097 endif
3098
3099 detap=(ypjtl-yhaha)*etafac
3100 detat=-yhaha*etafac
3101 tpro=dcosh(detap)
3102 zpro=dsinh(detap)
3103 ttar=dcosh(detat)
3104 ztar=dsinh(detat)
3105
3106 egyevt=engy
3107 ekievt=ekin
3108 pmxevt=pnll
3109
3110 if(iappl.gt.9)stop'update following statement'
3111 if(iappl.ge.5.and.iappl.le.9)then
3112 s=12.**2
3113 endif
3114
3115 !~~~~~redefine energy in case of imposed radial flow~~~~~~~~~~~~~~~~
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132 if(iappl.le.3)then
3133 if(maproj.gt.1)then
3134 rpj=1.19*maproj**(1./3.)-1.61*maproj**(-1./3.)
3135 rmproj=rpj+fctrmx*.54
3136 rcproj=dble(rpj/cosh(yhaha)*facnuc)
3137 else
3138 rmproj=0
3139 rcproj=dble(0.8/cosh(yhaha)*facnuc)
3140 endif
3141 if(matarg.gt.1)then
3142 rtg=1.19*matarg**(1./3.)-1.61*matarg**(-1./3.)
3143 rmtarg=rtg+fctrmx*.54
3144 rctarg=dble(rtg/cosh(yhaha)*facnuc)
3145 else
3146 rmtarg=0
3147 rctarg=dble(0.8/cosh(yhaha)*facnuc)
3148 endif
3149
3150 endif
3151
3152 call iclass(idproj,iclpro)
3153 call iclass(idtarg,icltar)
3154 call emsini(engy,idproj,idtarg)
3155
3156 if(inicnt.eq.1)then
3157
3158
3159
3160 call hdecin(.false.)
3161
3162 if(iappl.eq.1.or.iappl.ge.5)then
3163 c=6
3164 call utquaf(sptj,nptj,xptj,qptj,0.,.33*c,.66*c,c)
3165 endif
3166
3167 if(iappl.ne.2)then
3168 call hnbspd(iospec)
3169 ktnbod=0
3170
3171 call hnbpajini
3172 endif
3173
3174 if(model.eq.1)then
3175 if(iclegy2.gt.1)then
3176 egyfac=(egymax*1.0001/egylow)**(1./float(iclegy2-1))
3177 else
3178 egyfac=1.
3179 endif
3180 call psaini
3181 call conini
3182 else
3183 iorsce=0
3184 iorsdf=0
3185 iorshh=0
3186 iorsdf=0
3187 endif
3188
3189
3190
3191
3192
3193 endif !inicnt=1
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204 if(model.eq.1)then !only for epos
3205
3206 koll=1 !because it's needed in Gfunpar
3207
3208 if(iappl.le.3)then
3209 call paramini(1)
3210 if(ish.ge.4)then
3211 do i=idxD0,idxD1
3212 write(ifch,'(9(a,f8.4))')
3213 * 'AlpD:',alpD(i,iclpro,icltar)
3214 * ,' AlpDp:',alpDp(i,iclpro,icltar)
3215 * ,' AlpDpp:',alpDpp(i,iclpro,icltar)
3216 * ,' BetD:',betD(i,iclpro,icltar)
3217 * ,' BetDp:',betDp(i,iclpro,icltar)
3218 * ,' BetDpp:',betDpp(i,iclpro,icltar)
3219 * ,' GamD:',gamD(i,iclpro,icltar)
3220 * ,' DelD:',delD(i,iclpro,icltar)
3221 * ,' AlpPar:',alppar
3222 * ,' bkmxdif:',bmxdif(iclpro,icltar)
3223 enddo
3224 endif
3225 endif
3226
3227 if(iappl.le.3)then
3228 bkmxndif=conbmxndif()
3229 bkmx=conbmx()
3230 if(ish.ge.3)write(ifch,*)'bkmx,bkmxndif',bkmx,bkmxndif
3231
3232 if(maproj.gt.1.or.matarg.gt.1)then
3233 bmax=rmproj+rmtarg
3234 else
3235 bmax=bkmx
3236 endif
3237 endif
3238
3239 if(ixtau.eq.1)call xtauev(0)
3240
3241 if(model.eq.1)then
3242 if(iEmsB.eq.1)call xEmsB(0,0,0)
3243 if(iEmsBg.eq.1)call xEmsBg(0,0,0)
3244 if(iEmsPm.eq.1)call xEmsPm(0,0,0,0)
3245 if(iEmsPx.eq.1)call xEmsPx(0,0.,0.,0)
3246 if(iEmsPBx.eq.1)call xEmsP2(0,0,0,0.,0.,0.,0.,0.,0.)
3247 c if(iEmsPx.eq.1)call xEmsPxNo(0,0.,0.,0,0)
3248 if(iEmsSe.eq.1)call xEmsSe(0,0.,0.,0,1)
3249 if(iEmsSe.eq.1)call xEmsSe(0,0.,0.,0,2)
3250 if(iEmsDr.eq.1)call xEmsDr(0,0.,0.,0)
3251 if(iEmsRx.eq.1)call xEmsRx(0,0,0.,0.)
3252 endif
3253
3254 c G function parameters !-----> a verifier ?????????? (AA ??)
3255
3256 if(iappl.eq.1)then
3257 call Gfunpar(0.,0.,1,1,0.,s,alp,bet,betp,epsp,epst,epss,gamvv)
3258 epszero=epss
3259 do i=1,nclha
3260 alpff(i)= engy**epszero*gamhad(i)
3261 enddo
3262 betff(1)= -alppar+epsp
3263 betff(2)= -alppar+epst
3264 else
3265 epszero=0.
3266 endif
3267
3268 endif
3269
3270 c additional initialization procedures
3271
3272 if(model.ne.1)then
3273 call IniEvtModel
3274 elseif(iappl.le.3)then
3275 c Cross section calculation
3276 call xsigma
3277 endif
3278
3279
3280 if(idtarg.eq.0)idtarg=1120 !air = nucleus
3281
3282
3283
3284 if(inicnt.eq.1.and.noebin.ge.0)then
3285 call aseed(2)
3286 else !to use the proper random sequence
3287 call ranfini(seedc,iseqsim,0)
3288 if(noebin.ge.0.and.nevent.gt.0)call aseed(2)
3289 endif
3290
3291 ccc call MakeFpartonTable
3292
3293 c$$$ call testconex(1)
3294
3295 call utprix('ainit ',ish,ishini,4)
3296 return
3297 end
3298
3299 c---------------------------------------------------------------------
3300 subroutine aread
3301 c---------------------------------------------------------------------
3302 c reads and interprets input commands
3303 c---------------------------------------------------------------------
3304
3305 include 'epos.inc'
3306 include 'epos.incpar'
3307 include 'epos.incsem'
3308
3309 double precision histoweight
3310 common/chiswei/histoweight
3311 common/cyield/yield/cifset/ifset/caverg/averg
3312 common/csigma/sigma
3313 double precision val,val1,val2
3314 character*1000 line,linex,cline
3315 data nappl /0/
3316 common/record/maxrec(2),irecty(30,2)
3317 common/cfacmss/facmss /cr3pomi/r3pomi,r4pomi
3318 common /ems12/iodiba,bidiba ! defaut iodiba=0. if iodiba=1, study H-Dibaryon
3319 character*500 fndat,fnncs,fnIIdat,fnIIncs !qgs-II????????
3320 common/qgsfname/ fndat, fnncs, ifdat, ifncs
3321 common/qgsIIfname/fnIIdat, fnIIncs, ifIIdat, ifIIncs !qgs-II????????
3322 common/qgsnfname/ nfndat, nfnncs
3323 common/qgsIInfname/ nfnIIdat, nfnIIncs !qgs-II????????
3324 common/ghecsquel/anquasiel,iquasiel
3325 common/cjjj/jjj,cline
3326 character cmodel*21
3327 parameter(mxdefine=40)
3328 character w1define*100,w2define*100
3329 common/cdefine/ndefine,l1define(mxdefine),l2define(mxdefine)
3330 & ,w1define(mxdefine),w2define(mxdefine)
3331 common/cbincond/nozero,ibmin,ibmax
3332 common/photrans/phoele(4),ebeam
3333
3334
3335 j=-1
3336 nhsto=0
3337 ndefine=0
3338
3339 1 call utword(line,i,j,1)
3340
3341 if(line(i:j).eq.'#define')then
3342
3343 call utword(line,i,j,ne)
3344 if(line(i:j).eq.'bim3')stop'****** bim3->bim03 ****** '
3345 if(line(i:j).eq.'bim5')stop'****** bim5->bim05 ****** '
3346 if(line(i:j).eq.'bim6')stop'****** bim6->bim06 ****** '
3347 if(ndefine+1.gt.mxdefine)stop'too many `define` statements. '
3348 l1=j-i+1
3349 if(l1.gt.99)stop'`define` argument 1 too long. '
3350 w1define(ndefine+1)(1:l1)=line(i:j)
3351 w1define(ndefine+1)(l1+1:l1+1)=' '
3352 call utword(line,i,j,ne)
3353 l2=j-i+1
3354 if(l2.gt.99)stop'`define` argument 2 too long. '
3355 w2define(ndefine+1)(1:l2)=line(i:j)
3356 w2define(ndefine+1)(l2+1:l2+1)=' '
3357 ndefine=ndefine+1
3358 l1define(ndefine)=l1
3359 l2define(ndefine)=l2
3360
3361 elseif(line(i:j).eq.'goto')then
3362
3363 call utword(line,i,j,ne)
3364 ix=i
3365 jx=j
3366 linex=line
3367 call utword(line,i,j,ne)
3368 do while(line(i:j).ne.linex(ix:jx))
3369 call utword(line,i,j,ne)
3370 enddo
3371 goto1
3372
3373 elseif(line(i:j).eq.'application')then
3374
3375 call utworn(line,j,ne)
3376 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'application?'
3377 call utword(line,i,j,0)
3378 if(nopen.ne.-1)then !only first read
3379 if(line(i:j).eq.'conversion')iappl=-1
3380 if(line(i:j).eq.'analysis') iappl=0
3381 if(line(i:j).eq.'hadron') iappl=1
3382 if(line(i:j).eq.'geometry') iappl=2
3383 if(line(i:j).eq.'read') iappl=3
3384 if(line(i:j).eq.'micro') iappl=4
3385 if(line(i:j).eq.'kinky') iappl=5
3386 if(line(i:j).eq.'ee') iappl=6
3387 if(line(i:j).eq.'decay') iappl=7
3388 if(line(i:j).eq.'lepton') iappl=8
3389 if(line(i:j).eq.'hydro') iappl=9
3390 if(line(i:j).eq.'ee') then
3391 naflav=5 ! number of flavors
3392 endif
3393 nappl=nappl+1
3394 if(iappl.ne.0.and.nappl.gt.1)call aaset(1)
3395 if(iappl.eq.0.and.nappl.gt.1)call aaset(2)
3396 if(iappl.eq.0)jframe=iframe
3397 if(iappl.eq.0)kframe=iframe
3398 if(iappl.eq.1)iframe=0
3399 if(iappl.eq.2)iframe=0
3400 if(iappl.eq.4)iframe=1
3401 if(iappl.eq.5)iframe=1
3402 if(iappl.eq.6)iframe=1
3403 if(iappl.eq.7)iframe=0
3404 if(iappl.eq.8)iframe=21 !gncm
3405 endif
3406
3407 elseif(line(i:j).eq.'call')then
3408
3409 call utworn(line,j,ne)
3410 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'subroutine?'
3411 call utword(line,i,j,0)
3412
3413 if(nopen.eq.-1)then !-----only second run
3414
3415 if(line(i:j).eq.'xEnergy')call xEnergy
3416 if(line(i:j).eq.'xCoopFryRapPi')call xCoopFryRap(1)
3417 if(line(i:j).eq.'xCoopFryRapKa')call xCoopFryRap(2)
3418 if(line(i:j).eq.'xCoopFryPtPi')call xCoopFryPt(1)
3419 if(line(i:j).eq.'xCoopFryPtKa')call xCoopFryPt(2)
3420 if(line(i:j).eq.'xCoopFryV2Pi')call xCoopFryV2(1)
3421 if(line(i:j).eq.'xCoopFryV2Ka')call xCoopFryV2(2)
3422 if(line(i:j).eq.'xConThickProj')call xConThick(1)
3423 if(line(i:j).eq.'xConThickTarg')call xConThick(2)
3424 if(line(i:j).eq.'xConNuclDensProj')call xConNuclDens(1)
3425 if(line(i:j).eq.'xConNuclDensTarg')call xConNuclDens(2)
3426 if(line(i:j).eq.'xConNuclDensProjTarg')call xConNuclDens(1)
3427 if(line(i:j).eq.'xConNuclDensProjTarg')call xConNuclDens(2)
3428 if(line(i:j).eq.'xFom')call xfom
3429 if(line(i:j).eq.'xGeometry')call xGeometry(2)
3430 if(line(i:j).eq.'xbDens')call xbDens(2)
3431 if(line(i:j).eq.'xEpsilon')call xEpsilon(2)
3432 if(line(i:j).eq.'xZnucTheo')call xZnucTheo
3433 if(line(i:j).eq.'xRanPt')call xRanPt
3434 if(line(i:j).eq.'xParGam')call xParGam
3435 if(line(i:j).eq.'xParGampp')call xParGampp
3436 if(line(i:j).eq.'xParOmega1xy')call xParOmega1xy
3437 c$$$ if(line(i:j).eq.'xParOmega3xyz')call xParOmega3xyz
3438 if(line(i:j).eq.'xParPro')call xParPro
3439 if(line(i:j).eq.'xParPro1')call xParPro1
3440 if(line(i:j).eq.'xParPomInc')call xParPomInc
3441 if(line(i:j).eq.'xParPomIncX')call xParPomIncX
3442 if(line(i:j).eq.'xParPomIncP')call xParPomIncP
3443 if(line(i:j).eq.'xParPomIncM')call xParPomIncM
3444 if(line(i:j).eq.'xParPomIncXI')call xParPomIncXI
3445 if(line(i:j).eq.'xParPomIncPI')call xParPomIncPI
3446 if(line(i:j).eq.'xParPomIncMI')call xParPomIncMI
3447 if(line(i:j).eq.'xParPomIncJ')call xParPomIncJ
3448 if(line(i:j).eq.'xParOmega1')call xParOmega1
3449 c$$$ if(line(i:j).eq.'xParOmega3')call xParOmega3
3450 c$$$ if(line(i:j).eq.'xParOmega5')call xParOmega5
3451 if(line(i:j).eq.'xParOmegaN')call xParOmegaN
3452 if(line(i:j).eq.'xParGauss')call xParGauss
3453 if(line(i:j).eq.'xParSigma')call xParSigma
3454 c$$$ if(line(i:j).eq.'xParSigma2')call xParSigma2
3455 c$$$ if(line(i:j).eq.'xScrD')call xScrD
3456 if(line(i:j).eq.'xFitD1')call xFitD1
3457 c$$$ if(line(i:j).eq.'xExaD2')call xExaD2
3458 if(line(i:j).eq.'xbExaD')call xbExaD
3459 c$$$ if(line(i:j).eq.'xbExaD2')call xbExaD2
3460 if(line(i:j).eq.'xbnExaD')call xbnExaD
3461 c$$$ if(line(i:j).eq.'xbnExaD2')call xbnExaD2
3462 if(line(i:j).eq.'xFitD2')call xFitD2
3463 if(line(i:j).eq.'xbParD')call xbParD
3464 c$$$ if(line(i:j).eq.'xParD2')call xParD2
3465 if(line(i:j).eq.'xGexaJ')call xGexaJ
3466 if(line(i:j).eq.'xbnParD')call xbnParD
3467 if(line(i:j).eq.'xsParD')call xsParD
3468 c$$$ if(line(i:j).eq.'xmParD2')call xmParD2
3469 if(line(i:j).eq.'xyParD')call xyParD
3470 c$$$ if(line(i:j).eq.'xyParD2')call xyParD2
3471 if(line(i:j).eq.'xParPhi1')call xParPhi1
3472 if(line(i:j).eq.'xParPhi')call xParPhi
3473 if(line(i:j).eq.'xParH')call xParH
3474 if(line(i:j).eq.'xParHPhiInt')call xParHPhiInt
3475 if(line(i:j).eq.'xParZ')call xParZ
3476 if(line(i:j).eq.'xtauev')call xtauev(2)
3477 if(line(i:j).eq.'xspace')call xspace(2)
3478 if(line(i:j).eq.'gakjto' )call gakjto
3479 if(line(i:j).eq.'psaevp')call psaevp
3480 c if(line(i:j).eq.'pyarea')call pyarea
3481 if(line(i:j).eq.'xjden1')call xjden1(2,0,0.,0.,0.,0.,0.)
3482 if(line(i:j).eq.'xjden2')call xjden2(2,0,0.,0.,0.,0.)
3483 c if(line(i:j).eq.'xjdis' )call xjdis(2,0,0)
3484 if(model.eq.1)then
3485 if(line(i:j).eq.'xEmsB' )call xEmsB(2,0,0)
3486 if(line(i:j).eq.'xEmsBg')call xEmsBg(2,0,0)
3487 if(line(i:j).eq.'xEmsPm')call xEmsPm(2,0,0,0)
3488 if(line(i:j).eq.'xEmsPx')call xEmsPx(2,0.,0.,0)
3489 c if(line(i:j).eq.'xEmsPx')call xEmsPxNo(2,0.,0.,0,0)
3490 if(line(i:j).eq.'xEmsSe')call xEmsSe(2,0.,0.,0,1)
3491 if(line(i:j).eq.'xEmsSe')call xEmsSe(2,0.,0.,0,2)
3492 if(line(i:j).eq.'xEmsDr')call xEmsDr(2,0.,0.,0)
3493 if(line(i:j).eq.'xEmsRx')call xEmsRx(2,0,0.,0.)
3494 if(line(i:j-4).eq.'xEmsP2')then
3495 read(line(j-1:j-1),*)val
3496 idh=nint(val)
3497 read(line(j:j),*)val
3498 jex=nint(val)
3499 if(line(j-3:j-2).eq.'PE')
3500 & call xEmsP2(2,idh,jex,0.,0.,0.,0.,0.,0.)
3501 if(line(j-3:j-2).eq.'IB')
3502 & call xEmsP2(3,idh,jex,0.,0.,0.,0.,0.,0.)
3503 if(line(j-3:j-2).eq.'OB')
3504 & call xEmsP2(4,idh,jex,0.,0.,0.,0.,0.,0.)
3505 endif
3506 if(line(i:j).eq.'xConxyzProj')
3507 &stop'xConxyzProj->xConNuclDensProj'
3508 if(line(i:j).eq.'xConxyzTarg')
3509 &stop'xConxyzTarg->xConNuclDensTarg'
3510 if(line(i:j).eq.'xConxyzProjTarg')
3511 &stop'xConxyzProjTarg->xConNuclDensProjTarg'
3512
3513 endif
3514
3515 elseif(model.eq.1)then !first run and epos
3516
3517 if(line(i:j).eq.'xGeometry')then
3518 call xGeometry(0)
3519 ixgeometry=1
3520 elseif(line(i:j).eq.'xEpsilon')then
3521 call xEpsilon(0)
3522 elseif(line(i:j).eq.'xbDens')then
3523 ixbDens=1
3524 elseif(line(i:j).eq.'xtauev')then
3525 ixtau=1
3526 elseif(line(i:j).eq.'xEmsB')then
3527 iEmsB=1
3528 elseif(line(i:j).eq.'xEmsBg')then
3529 iEmsBg=1
3530 elseif(line(i:j).eq.'xEmsPm')then
3531 iEmsPm=1
3532 elseif(line(i:j).eq.'xEmsPx')then
3533 iEmsPx=1
3534 elseif(line(i:j-4).eq.'xEmsP2')then
3535 iEmsPBx=1
3536 elseif(line(i:j).eq.'xEmsSe')then
3537 iEmsSe=1
3538 elseif(line(i:j).eq.'xEmsDr')then
3539 iEmsDr=1
3540 elseif(line(i:j).eq.'xEmsRx')then
3541 iEmsRx=1
3542 elseif(line(i:j).eq.'xEmsI1')then
3543 iEmsI1=1
3544 if(iEmsI1+iEmsI2.eq.1)write(ifhi,'(a)')'newpage zone 3 4 1'
3545 elseif(line(i:j).eq.'xEmsI2')then
3546 iEmsI2=1
3547 if(iEmsI1+iEmsI2.eq.1)write(ifhi,'(a)')'newpage zone 3 4 1'
3548 elseif(line(i:j).eq.'xSpaceTime')then
3549 iSpaceTime=1
3550 elseif(line(i:j).eq.'xxSpaceTime')then
3551 stop'xxSpaceTime->xSpaceTime. '
3552 endif
3553 endif
3554
3555 elseif(line(i:j).eq.'decayall')then
3556
3557 nrnody=0
3558
3559 elseif(line(i:j).eq.'echo')then
3560
3561 call utworn(line,j,ne)
3562 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'on or off?'
3563 call utword(line,i,j,0)
3564 if(line(i:j).eq.'on')iecho=1
3565 if(line(i:j).eq.'off')iecho=0
3566 if(line(i:j).ne.'on'.and.line(i:j).ne.'off')stop'invalid option'
3567 if(nopen.eq.-1)iecho=0
3568
3569 elseif(line(i:j).eq.'fqgsjet')then !QGSJet
3570
3571 call utworn(line,j,ne)
3572 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'file-type file-name?'
3573 call utword(line,i,j,0)
3574 linex=line
3575 ix=i
3576 jx=j
3577 call utworn(line,j,ne)
3578 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'file-name?'
3579 call utword(line,i,j,0)
3580 if(linex(ix:jx).eq.'dat')fndat(1:j-i+1)=line(i:j)
3581 if(linex(ix:jx).eq.'dat')nfndat=j-i+1 !length of qgsdat01-file name
3582 if(linex(ix:jx).eq.'ncs')fnncs(1:j-i+1)=line(i:j)
3583 if(linex(ix:jx).eq.'ncs')nfnncs=j-i+1 !length of sectnu-file name
3584 if(nfndat.gt.1)ifdat=1
3585 if(nfnncs.gt.1)ifncs=2
3586
3587 elseif(line(i:j).eq.'fqgsjetII')then !QGSJET-II !qgs-II????????
3588
3589 call utworn(line,j,ne)
3590 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'file-type file-name?'
3591 call utword(line,i,j,0)
3592 linex=line
3593 ix=i
3594 jx=j
3595 call utworn(line,j,ne)
3596 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'file-name?'
3597 call utword(line,i,j,0)
3598 if(linex(ix:jx).eq.'dat')fnIIdat(1:j-i+1)=line(i:j)
3599 if(linex(ix:jx).eq.'dat')nfnIIdat=j-i+1 !length of qgsjet-II.dat name
3600 if(linex(ix:jx).eq.'ncs')fnIIncs(1:j-i+1)=line(i:j)
3601 if(linex(ix:jx).eq.'ncs')nfnIIncs=j-i+1 !length of qgsjet-II.ncs name
3602 if(nfnIIdat.gt.1)ifIIdat=1
3603 if(nfnIIncs.gt.1)ifIIncs=2
3604
3605 elseif(line(i:j).eq.'fname')then
3606
3607 call utworn(line,j,ne)
3608 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'file-type file-name?'
3609 call utword(line,i,j,0)
3610 linex=line
3611 ix=i
3612 jx=j
3613 call utworn(line,j,ne)
3614 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'file-name?'
3615 call utword(line,i,j,0)
3616 if(linex(ix:jx).eq.'pathnx')fnnx(1:j-i+1)=line(i:j)
3617 if(linex(ix:jx).eq.'check')fnch(1:j-i+1)=line(i:j)
3618 if(linex(ix:jx).eq.'histo')fnhi(1:j-i+1)=line(i:j)
3619 if(linex(ix:jx).eq.'data') fndt(1:j-i+1)=line(i:j)
3620 if(linex(ix:jx).eq.'input')fnin(1:j-i+1)=line(i:j)
3621 if(linex(ix:jx).eq.'copy') fncp(1:j-i+1)=line(i:j)
3622 if(linex(ix:jx).eq.'initl') fnii(1:j-i+1)=line(i:j)
3623 if(linex(ix:jx).eq.'initl+') fnii(nfnii+1:nfnii+j-i+1)=line(i:j)
3624 if(linex(ix:jx).eq.'inidi') fnid(1:j-i+1)=line(i:j)
3625 if(linex(ix:jx).eq.'inidi+') fnid(nfnid+1:nfnid+j-i+1)=line(i:j)
3626 if(linex(ix:jx).eq.'inidr') fndr(1:j-i+1)=line(i:j)
3627 if(linex(ix:jx).eq.'inidr+') fndr(nfndr+1:nfndr+j-i+1)=line(i:j)
3628 if(linex(ix:jx).eq.'iniev') fnie(1:j-i+1)=line(i:j)
3629 if(linex(ix:jx).eq.'iniev+') fnie(nfnie+1:nfnie+j-i+1)=line(i:j)
3630 if(linex(ix:jx).eq.'inirj') fnrj(1:j-i+1)=line(i:j)
3631 if(linex(ix:jx).eq.'inirj+') fnrj(nfnrj+1:nfnrj+j-i+1)=line(i:j)
3632 if(linex(ix:jx).eq.'inics') fncs(1:j-i+1)=line(i:j)
3633 if(linex(ix:jx).eq.'inics+') fncs(nfncs+1:nfncs+j-i+1)=line(i:j)
3634 if(linex(ix:jx).eq.'pathnx')nfnnx=j-i+1
3635 if(linex(ix:jx).eq.'check')nfnch=j-i+1
3636 if(linex(ix:jx).eq.'histo')nfnhi=j-i+1
3637 if(linex(ix:jx).eq.'data') nfndt=j-i+1
3638 if(linex(ix:jx).eq.'input')nfnin=j-i+1
3639 if(linex(ix:jx).eq.'copy') nfncp=j-i+1
3640 if(linex(ix:jx).eq.'initl') nfnii=j-i+1
3641 if(linex(ix:jx).eq.'initl+')nfnii=nfnii+j-i+1
3642 if(linex(ix:jx).eq.'inidi') nfnid=j-i+1
3643 if(linex(ix:jx).eq.'inidi+')nfnid=nfnid+j-i+1
3644 if(linex(ix:jx).eq.'inidr') nfndr=j-i+1
3645 if(linex(ix:jx).eq.'inidr+')nfndr=nfndr+j-i+1
3646 if(linex(ix:jx).eq.'iniev') nfnie=j-i+1
3647 if(linex(ix:jx).eq.'iniev+')nfnie=nfnie+j-i+1
3648 if(linex(ix:jx).eq.'inirj') nfnrj=j-i+1
3649 if(linex(ix:jx).eq.'inirj+')nfnrj=nfnrj+j-i+1
3650 if(linex(ix:jx).eq.'inics') nfncs=j-i+1
3651 if(linex(ix:jx).eq.'inics+')nfncs=nfncs+j-i+1
3652 if(linex(ix:jx).eq.'check'.and.fnch(1:nfnch).ne.'none') then
3653 open(unit=ifcx,file=fnch(1:nfnch),status='unknown')
3654 kchopen=1
3655 elseif(linex(ix:jx).eq.'pathnx'.and.fnnx(1:nfnnx).ne.'none')then
3656 knxopen=1
3657 elseif(linex(ix:jx).eq.'histo'.and.fnhi(1:nfnhi).ne.'none')then
3658 open(unit=ifhi,file=fnhi(1:nfnhi),status='unknown')
3659 khiopen=1
3660 elseif(linex(ix:jx).eq.'data'.and.fndt(1:nfndt).ne.'none')then
3661 open(unit=ifdt,file=fndt(1:nfndt),status='unknown')
3662 kdtopen=1
3663 elseif(linex(ix:jx).eq.'copy'.and.fncp(1:nfncp).ne.'none')then
3664 open(unit=ifcp,file=fncp(1:nfncp),status='unknown')
3665 kcpopen=1
3666 endif
3667
3668 elseif(line(i:j).eq.'frame')then
3669
3670
3671 call utworn(line,j,ne)
3672 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'frame?'
3673 call utword(line,i,j,0)
3674 if(nopen.ne.-1)then ! event definition only, not analysis
3675 if(line(i:j).eq.'nucleon-nucleon')then
3676 if(iappl.eq.0)jframe=11
3677 if(abs(iappl).eq.1)iframe=11
3678 if(iappl.eq.3)iframe=11
3679 if(iappl.gt.3.or.iappl.eq.2)stop'invalid option nucleon-nucleon'
3680 elseif(line(i:j).eq.'target')then
3681 if(iappl.eq.0)jframe=12
3682 if(abs(iappl).eq.1)iframe=12
3683 if(iappl.eq.3)iframe=12
3684 if(iappl.gt.3.or.iappl.eq.2)stop'invalid option target'
3685 elseif(line(i:j).eq.'gamma-nucleon')then
3686 if(iappl.eq.0)then
3687 jframe=21
3688 elseif(iappl.le.3.and.iappl.ne.2)then
3689 iframe=21
3690 endif
3691 if((iappl+1)/2.eq.4)iframe=21
3692 if(iappl.ne.0.and.(iappl+1)/2.ne.4.and.iappl.ne.3
3693 * .and.abs(iappl).ne.1)stop'invalid option gamma-nucleon'
3694 elseif(line(i:j).eq.'lab')then
3695 if(iappl.eq.0)then
3696 jframe=22
3697 elseif(iappl.le.3.and.iappl.ne.2)then
3698 iframe=22
3699 endif
3700 if((iappl+1)/2.eq.4)iframe=22
3701 if(iappl.ne.0.and.(iappl+1)/2.ne.4.and.iappl.ne.3
3702 * .and.abs(iappl).ne.1)stop'invalid option lab'
3703 elseif(line(i:j).eq.'sphericity')then
3704 if(iappl.eq.0)jframe=32
3705 if(iappl.ne.0)stop'invalid option sphericity'
3706 elseif(line(i:j).eq.'thrust')then
3707 if(iappl.eq.0)jframe=33
3708 if(iappl.ne.0)stop'invalid option thrust'
3709 elseif(line(i:j).eq.'breit')then
3710 if(iappl.ne.0)stop'invalid option breit'
3711 else
3712 stop'frame not recognized'
3713 endif
3714 endif
3715
3716 elseif(line(i:j).eq.'frame+')then
3717
3718 call utword(line,i,j,0)
3719
3720 elseif(line(i:j).eq.'binning')then
3721
3722 call utworn(line,j,ne)
3723 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'log/lin?'
3724 call utword(line,i,j,0)
3725 if(line(i:j).eq.'lin')iologb=0
3726 if(line(i:j).eq.'log')iologb=1
3727
3728 elseif(line(i:j).eq.'beginhisto'.or.line(i:j).eq.'bh')then
3729
3730 if(nopen.ne.-1)then
3731 jjj=j
3732 cline=line
3733 call xini
3734 j=jjj
3735 line=cline
3736 endif
3737
3738 elseif(line(i:j).eq.'endhisto'.or.line(i:j).eq.'eh')then
3739
3740 if(nopen.eq.-1)then
3741 nhsto=nhsto+1
3742 call xhis(nhsto)
3743 endif
3744
3745 elseif(line(i:j).eq.'noweak')then
3746
3747 !only used in xini
3748
3749 elseif(line(i:j).eq.'histogram'.or.line(i:j).eq.'hi')then
3750
3751 call utword(line,i,j,0)
3752 call utword(line,i,j,0)
3753 call utword(line,i,j,0)
3754 call utword(line,i,j,0)
3755 call utword(line,i,j,0)
3756 call utword(line,i,j,0)
3757
3758 elseif(line(i:j).eq.'plot')then
3759
3760 stop' "plot" not used any more'
3761
3762 elseif(line(i:j).eq.'root')then
3763
3764 stop' "root" not used any more'
3765
3766 elseif(line(i:j).eq.'idcode')then
3767
3768 call utword(line,i,j,0)
3769
3770 elseif(line(i:j).eq.'xpara')then
3771
3772 call utword(line,i,j,0)
3773 call utword(line,i,j,0)
3774
3775 elseif(line(i:j).eq.'xparas')then
3776
3777 call utword(line,i,j,1)
3778 read(line(i:j),*)ipara
3779 do ii=1,ipara
3780 call utword(line,i,j,1)
3781 enddo
3782
3783 elseif(line(i:j).eq.'histoweight')then
3784
3785 if(nopen.eq.-1)then
3786 write(ifhi,'(a,e22.14)')'histoweight ',histoweight
3787 endif
3788
3789 elseif(line(i:j).eq.'histoweight-1')then
3790
3791 if(nopen.eq.-1)then
3792 write(ifhi,'(a,e22.14)')'histoweight -1'
3793 endif
3794
3795
3796 elseif(line(i:j).eq.'input')then
3797
3798 call utworn(line,j,ne)
3799 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'input file?'
3800 call utword(line,i,j,0)
3801 if(nopen.ge.0)then
3802 nopen=nopen+1
3803 if(nopen.gt.9)stop'too many nested input commands'
3804 open(unit=20+nopen,file=line(i:j),status='old')
3805 if(iprmpt.eq.1)iprmpt=-1
3806 endif
3807
3808 elseif(line(i:j).eq.'nodecays')then
3809
3810 call utword(line,i,j,0)
3811 do while (line(i:j).ne.'end')
3812 if(nrnody.ge.mxnody)then
3813 write(ifmt,'(a)')'too many nodecays; command ignored'
3814 else
3815 nrnody=nrnody+1
3816 read(line(i:j),*)val
3817 nody(nrnody)=nint(val)
3818 endif
3819 call utword(line,i,j,0)
3820 enddo
3821
3822 elseif(line(i:j).eq.'nodecay')then
3823
3824 call utword(line,i,j,0)
3825 if(nopen.ne.-1)then
3826 if(nrnody.ge.mxnody)then
3827 write(ifmt,'(a)')'too many nodecay commands; command ignored'
3828 j=1000
3829 i=j+1
3830 goto1
3831 endif
3832 nrnody=nrnody+1
3833 read(line(i:j),*)val
3834 nody(nrnody)=nint(val)
3835 endif
3836
3837 elseif(line(i:j).eq.'dodecay')then
3838
3839 call utword(line,i,j,0)
3840 if(nopen.ne.-1)then
3841 read(line(i:j),*)val
3842 idx=nint(val)
3843 nrn=0
3844 imv=0
3845 do while(nrn.lt.nrnody)
3846 nrn=nrn+1
3847 if(idx.eq.nody(nrn))then
3848 nrnody=nrnody-1
3849 imv=1
3850 endif
3851 if(imv.eq.1.and.nrn.le.nrnody)nody(nrn)=nody(nrn+1)
3852 enddo
3853 endif
3854
3855 elseif(line(i:j).eq.'MinDecayLength')then
3856
3857 call utword(line,i,j,0)
3858 if(nopen.ne.-1)then
3859 read(line(i:j),*)val
3860 ctaumin=val
3861 endif
3862
3863 elseif(line(i:j).eq.'print')then
3864
3865 call utworn(line,j,ne)
3866 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'subroutine?'
3867 call utword(line,i,j,0)
3868 if(line(i:j).eq.'*')then
3869 nrpri=0
3870 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'level?'
3871 call utword(line,i,j,0)
3872 read(line(i:j),*)val
3873 ish=nint(val)
3874 else
3875 nrpri=nrpri+1
3876 subpri(nrpri)=' '
3877 subpri(nrpri)(1:j-i+1)=line(i:j)
3878 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'level?'
3879 call utword(line,i,j,0)
3880 read(line(i:j),*)val
3881 ishpri(nrpri)=nint(val)
3882 endif
3883
3884 elseif(line(i:j).eq.'printcheck')then
3885
3886 call utworn(line,j,ne)
3887 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'screen or file?'
3888 call utword(line,i,j,0)
3889 if(line(i:j).eq.'screen')ifch=ifmt
3890 if(line(i:j).eq.'file')ifch=ifcx
3891 if(line(i:j).ne.'screen'.and.line(i:j).ne.'file')
3892 *write(ifmt,'(a)')'invalid option; command ignored'
3893
3894 elseif(line(i:j).eq.'prompt')then
3895
3896 call utworn(line,j,ne)
3897 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'on or off or auto?'
3898 call utword(line,i,j,0)
3899 if(line(i:j).eq.'on')iprmpt=2
3900 if(line(i:j).eq.'off')iprmpt=-2
3901 if(line(i:j).eq.'auto'.and.nopen.eq.0)iprmpt=1
3902 if(line(i:j).eq.'auto'.and.nopen.eq.1)iprmpt=-1
3903 if(line(i:j).ne.'on'.and.line(i:j).ne.'off'
3904 *.and.line(i:j).ne.'auto')stop'invalid option'
3905
3906 elseif(line(i:j).eq.'return')then
3907
3908 if(nopen.ne.-1)then
3909 close(ifop)
3910 nopen=nopen-1
3911 if(nopen.eq.0.and.iprmpt.eq.-1)iprmpt=1
3912 ccc close(20+nopen)
3913 ccc nopen=nopen-1
3914 ccc if(nopen.eq.0.and.iprmpt.eq.-1)iprmpt=1
3915 endif
3916
3917 elseif(line(i:j).eq.'run')then
3918
3919 elseif(line(i:j).eq.'runprogram')then
3920
3921 if(kchopen.eq.0.and.fnch(1:nfnch).ne.'none')then
3922 open(unit=ifcx,file=fnch(1:nfnch),status='unknown')
3923 kchopen=1
3924 endif
3925 if(khiopen.eq.0.and.fnhi(1:nfnhi).ne.'none')then
3926 open(unit=ifhi,file=fnhi(1:nfnhi),status='unknown')
3927 khiopen=1
3928 endif
3929 if(kdtopen.eq.0.and.fndt(1:nfndt).ne.'none')then
3930 open(unit=ifdt,file=fndt(1:nfndt),status='unknown')
3931 kdtopen=1
3932 endif
3933 if(kcpopen.eq.0.and.fncp(1:nfncp).ne.'none')then
3934 open(unit=ifcp,file=fncp(1:nfncp),status='unknown')
3935 kcpopen=1
3936 endif
3937 return
3938
3939 elseif(line(i:j).eq.'if')then
3940
3941 call utword(line,i,j,0)
3942 ix=i
3943 jx=j
3944 linex=line
3945 call utword(line,i,j,0)
3946 read(line(i:j),*)val1
3947 call utword(line,i,j,0)
3948 read(line(i:j),*)val2
3949 ifset=1
3950 if(linex(ix:jx).eq.'engy')then
3951 call idmass(idproj,amproj)
3952 call idmass(idtarg,amtarg)
3953 xxengy=0.
3954 if(engy.gt.0.)then
3955 xxengy=engy
3956 elseif(ecms.gt.0.)then
3957 xxengy=ecms
3958 elseif(elab.gt.0)then
3959 xxengy=sqrt( 2*elab*amtarg+amtarg**2+amproj**2 )
3960 elseif(pnll.gt.0)then
3961 xxengy=sqrt( 2*sqrt(pnll**2+amproj**2)*amtarg
3962 * +amtarg**2+amproj**2 )
3963 elseif(ekin.gt.0.)then
3964 xxelab=ekin+amproj
3965 xxengy=sqrt( 2*xxelab*amtarg+amtarg**2+amproj**2 )
3966 endif
3967 if(xxengy.lt.val1.or.xxengy.gt.val2)ifset=0
3968 elseif(linex(ix:jx).eq.'projtarg')then
3969 if(maproj.ne.nint(val1).or.matarg.ne.nint(val2))ifset=0
3970 endif
3971
3972 elseif(line(i:j).eq.'set'.and.ifset.eq.1)then
3973
3974 call utworn(line,j,ne)
3975 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'p/o-name p/o-value?'
3976 call utword(line,i,j,0)
3977 linex=line
3978 ix=i
3979 jx=j
3980 call utworn(line,j,ne)
3981 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'p/o-value?'
3982 call utword(line,i,j,0)
3983 if(linex(ix:jx).eq.'hydtab')then
3984 hydt=line(i:j)
3985 elseif(linex(ix:jx).eq.'xvaria')then
3986 xvaria=' '
3987 xvaria(1:j-i+1)=line(i:j)
3988 elseif(linex(ix:jx).eq.'yvaria')then
3989 yvaria=' '
3990 yvaria(1:j-i+1)=line(i:j)
3991 else
3992 read(line(i:j),*)val
3993 c general
3994 if(linex(ix:jx).eq.'model') model=nint(val)
3995 if(linex(ix:jx).eq.'iquasiel') iquasiel=nint(val)
3996 if(linex(ix:jx).eq.'iversn')iversn=nint(val)
3997 if(linex(ix:jx).eq.'iappl' )iappl=nint(val)
3998 if(linex(ix:jx).eq.'nevent')nevent=nint(val)
3999 if(linex(ix:jx).eq.'nfull') nfull=nint(val)
4000 if(linex(ix:jx).eq.'nfreeze')nfreeze=nint(val)
4001 if(linex(ix:jx).eq.'ninicon')ninicon=nint(val)
4002 if(linex(ix:jx).eq.'egymin' )egymin=sngl(val)
4003 if(linex(ix:jx).eq.'egymax' )egymax=sngl(val)
4004 c constants
4005 if(linex(ix:jx).eq.'ainfin')ainfin=sngl(val)
4006 c printout options
4007 if(linex(ix:jx).eq.'iprmpt')iprmpt=nint(val)
4008 if(linex(ix:jx).eq. 'ish' )ish=nint(val)
4009 if(linex(ix:jx).eq.'ishsub')ishsub=nint(val)
4010 if(linex(ix:jx).eq.'irandm')irandm=nint(val)
4011 if(linex(ix:jx).eq.'irewch')irewch=nint(val)
4012 if(linex(ix:jx).eq.'iecho ')iecho =nint(val)
4013 if(linex(ix:jx).eq.'modsho')modsho=nint(val)
4014 if(linex(ix:jx).eq.'idensi')idensi=nint(val)
4015 if(linex(ix:jx).eq.'infragm')infragm=nint(val)
4016 if(linex(ix:jx).eq.'ishevt')ishevt=nint(val)
4017 if(linex(ix:jx).eq.'iwseed')iwseed=nint(val)
4018 if(linex(ix:jx).eq.'jwseed')jwseed=nint(val)
4019 c fragmentation and decay
4020 if(linex(ix:jx).eq.'pdiqua')pdiqua=sngl(val)
4021 if(linex(ix:jx).eq.'pud' )pud =sngl(val)
4022 if(linex(ix:jx).eq.'pmqu' )pmqu =sngl(val)
4023 if(linex(ix:jx).eq.'pmqd' )pmqd =sngl(val)
4024 if(linex(ix:jx).eq.'pmqs ' )pmqs =sngl(val)
4025 if(linex(ix:jx).eq.'pmqc ' )pmqc =sngl(val)
4026 if(linex(ix:jx).eq.'pmqq ' )then
4027 pmqq =sngl(val)
4028 qmass(0)=pmqq
4029 endif
4030 if(linex(ix:jx).eq.'fkappa' )fkappa =sngl(val)
4031 if(linex(ix:jx).eq.'fkappag' )fkappag =sngl(val)
4032 if(linex(ix:jx).eq.'pudd ' )pudd =sngl(val)
4033 if(linex(ix:jx).eq.'puds ' )puds =sngl(val)
4034 if(linex(ix:jx).eq.'pudc ' )pudc =sngl(val)
4035 if(linex(ix:jx).eq.'strcut' )strcut =sngl(val)
4036 if(linex(ix:jx).eq.'diqcut' )diqcut =sngl(val)
4037 if(linex(ix:jx).eq.'ioptf ')ioptf =nint(val)
4038 if(linex(ix:jx).eq.'delrex')delrex=sngl(val)
4039 if(linex(ix:jx).eq.'ndecay')ndecay=nint(val)
4040 if(linex(ix:jx).eq.'maxres')maxres=nint(val)
4041 if(linex(ix:jx).eq.'pbreak')pbreak=sngl(val)
4042 if(linex(ix:jx).eq.'pbreakg')pbreakg=sngl(val)
4043 if(linex(ix:jx).eq.'zetacut')zetacut=sngl(val)
4044 if(linex(ix:jx).eq.'ptfra')ptfra=sngl(val)
4045 if(linex(ix:jx).eq.'ptfraqq')ptfraqq=sngl(val)
4046 if(linex(ix:jx).eq.'aouni ')aouni=sngl(val)
4047 c lepton-nucleon and e+e-
4048 if(linex(ix:jx).eq.'iolept')iolept=nint(val)
4049 if(linex(ix:jx).eq.'ydmin')ydmin=sngl(val)
4050 if(linex(ix:jx).eq.'ydmax')ydmax=sngl(val)
4051 if(linex(ix:jx).eq.'qdmin')qdmin=sngl(val)
4052 if(linex(ix:jx).eq.'qdmax')qdmax=sngl(val)
4053 if(linex(ix:jx).eq.'themin')themin=sngl(val)
4054 if(linex(ix:jx).eq.'themax')themax=sngl(val)
4055 if(linex(ix:jx).eq.'elomin')elomin=sngl(val)
4056 if(linex(ix:jx).eq.'engy' )engy=sngl(val)
4057 if(linex(ix:jx).eq.'elab' )elab=sngl(val)
4058 if(linex(ix:jx).eq.'ekin' )ekin=sngl(val)
4059 if(linex(ix:jx).eq.'ecms' )ecms=sngl(val)
4060 if(linex(ix:jx).eq.'ebeam' )ebeam=sngl(val)
4061 if(linex(ix:jx).eq.'elepti')elepti=sngl(val)
4062 if(linex(ix:jx).eq.'elepto')elepto=sngl(val)
4063 if(linex(ix:jx).eq.'angmue')angmue=sngl(val)
4064 if(linex(ix:jx).eq.'noebin')noebin=nint(val)
4065 if(linex(ix:jx).eq.'engmin')engmin=sngl(val)
4066 if(linex(ix:jx).eq.'engmax')engmax=sngl(val)
4067 if(linex(ix:jx).eq.'iologe')iologe=nint(val)
4068 if(linex(ix:jx).eq.'iologl')iologl=nint(val)
4069 if(linex(ix:jx).eq.'itflav')itflav=nint(val)
4070 if(linex(ix:jx).eq.'idisco')idisco=nint(val)
4071 c hadron-hadron
4072 if(linex(ix:jx).eq. 'pnll' )pnll=sngl(val)
4073 if(linex(ix:jx).eq.'idproj')idprojin=nint(val)
4074 idproj=idprojin
4075 if(linex(ix:jx).eq.'idtarg')idtargin=nint(val)
4076 idtarg=idtargin
4077 if(idtarg.eq.0)idtarg=1120
4078 if(linex(ix:jx).eq.'ptq ')ptq =sngl(val)
4079 if(linex(ix:jx).eq.'rstrau(1)')rstrau(1)=sngl(val)
4080 if(linex(ix:jx).eq.'rstrad(1)')rstrad(1)=sngl(val)
4081 if(linex(ix:jx).eq.'rstras(1)')rstras(1)=sngl(val)
4082 if(linex(ix:jx).eq.'rstrac(1)')rstrac(1)=sngl(val)
4083 if(linex(ix:jx).eq.'rstrau(2)')rstrau(2)=sngl(val)
4084 if(linex(ix:jx).eq.'rstrad(2)')rstrad(2)=sngl(val)
4085 if(linex(ix:jx).eq.'rstras(2)')rstras(2)=sngl(val)
4086 if(linex(ix:jx).eq.'rstrac(2)')rstrac(2)=sngl(val)
4087 if(linex(ix:jx).eq.'rstrau(3)')rstrau(3)=sngl(val)
4088 if(linex(ix:jx).eq.'rstrad(3)')rstrad(3)=sngl(val)
4089 if(linex(ix:jx).eq.'rstras(3)')rstras(3)=sngl(val)
4090 if(linex(ix:jx).eq.'rstrac(3)')rstrac(3)=sngl(val)
4091 if(linex(ix:jx).eq.'rstrau(4)')rstrau(4)=sngl(val)
4092 if(linex(ix:jx).eq.'rstrad(4)')rstrad(4)=sngl(val)
4093 if(linex(ix:jx).eq.'rstras(4)')rstras(4)=sngl(val)
4094 if(linex(ix:jx).eq.'rstrac(4)')rstrac(4)=sngl(val)
4095 if(linex(ix:jx).eq.'rstrasi')rstrasi=sngl(val)
4096 if(linex(ix:jx).eq.'wgtval')wgtval=sngl(val)
4097 if(linex(ix:jx).eq.'wgtsea')wgtsea=sngl(val)
4098 if(linex(ix:jx).eq.'wgtdiq')wgtdiq=sngl(val)
4099 if(linex(ix:jx).eq.'wgtqqq(1)')wgtqqq(1)=sngl(val)
4100 if(linex(ix:jx).eq.'wgtqqq(2)')wgtqqq(2)=sngl(val)
4101 if(linex(ix:jx).eq.'wgtqqq(3)')wgtqqq(3)=sngl(val)
4102 if(linex(ix:jx).eq.'wgtqqq(4)')wgtqqq(4)=sngl(val)
4103 if(linex(ix:jx).eq.'wproj ')wproj =sngl(val)
4104 if(linex(ix:jx).eq.'wtarg ')wtarg =sngl(val)
4105 if(linex(ix:jx).eq.'wexcit')wexcit=sngl(val)
4106 c if(linex(ix:jx).eq.'cutmsq')cutmsq=sngl(val)
4107 if(linex(ix:jx).eq.'cutmss')cutmss=sngl(val)
4108 if(linex(ix:jx).eq.'exmass')exmass=sngl(val)
4109 if(linex(ix:jx).eq.'iregge')iregge=nint(val)
4110 if(linex(ix:jx).eq.'isopom')isopom=nint(val)
4111 if(linex(ix:jx).eq.'ishpom')ishpom=nint(val)
4112 if(linex(ix:jx).eq.'iscreen')iscreen=nint(val)
4113 if(linex(ix:jx).eq.'isplit')isplit=nint(val)
4114 if(linex(ix:jx).eq.'irzptn')irzptn=nint(val)
4115 if(linex(ix:jx).eq.'irmdrop')irmdrop=nint(val)
4116 if(linex(ix:jx).eq.'nprmax')nprmax=nint(val)
4117 if(linex(ix:jx).eq.'iemspl')iemspl=nint(val)
4118 if(linex(ix:jx).eq.'intpol')intpol=nint(val)
4119 if(linex(ix:jx).eq.'isigma')isigma=nint(val)
4120 if(linex(ix:jx).eq.'iomega')iomega=nint(val)
4121 if(linex(ix:jx).eq.'isetcs')isetcs=nint(val)
4122 if(linex(ix:jx).eq.'iemsb' )iemsb= nint(val)
4123 if(linex(ix:jx).eq.'iemspm')iemspm=nint(val)
4124 if(linex(ix:jx).eq.'iemspx')iemspx=nint(val)
4125 if(linex(ix:jx).eq.'iemsse')iemsse=nint(val)
4126 if(linex(ix:jx).eq.'iemsdr')iemsdr=nint(val)
4127 if(linex(ix:jx).eq.'iemsrx')iemsrx=nint(val)
4128 if(linex(ix:jx).eq.'iemsi2')iemsi2=nint(val)
4129 if(linex(ix:jx).eq.'iemsi1')iemsi1=nint(val)
4130 if(linex(ix:jx).eq.'ioems' )ioems= nint(val)
4131 if(linex(ix:jx).eq.'ispacetime')ispacetime= nint(val)
4132 c unified parameters
4133 if(linex(ix:jx).eq.'iclpro1')iclpro1=nint(val)
4134 if(linex(ix:jx).eq.'iclpro2')iclpro2=nint(val)
4135 if(linex(ix:jx).eq.'icltar1')icltar1=nint(val)
4136 if(linex(ix:jx).eq.'icltar2')icltar2=nint(val)
4137 if(linex(ix:jx).eq.'iclegy1')iclegy1=nint(val)
4138 if(linex(ix:jx).eq.'iclegy2')iclegy2=nint(val)
4139 if(linex(ix:jx).eq.'egylow')egylow=sngl(val)
4140 if(linex(ix:jx).eq.'alppom')alppom=sngl(val)
4141 if(linex(ix:jx).eq.'gamhad(1)')stop'gamhad(1) not allowed'
4142 if(linex(ix:jx).eq.'gamhad(2)')gamhad(2)=sngl(val)
4143 if(linex(ix:jx).eq.'gamhad(3)')stop'gamhad(3) not allowed'
4144 if(linex(ix:jx).eq.'gamhads(1)')gamhadsi(1)=sngl(val)
4145 if(linex(ix:jx).eq.'gamhads(2)')gamhadsi(2)=sngl(val)
4146 if(linex(ix:jx).eq.'gamhads(3)')gamhadsi(3)=sngl(val)
4147 if(linex(ix:jx).eq.'gamhads(4)')gamhadsi(4)=sngl(val)
4148 if(linex(ix:jx).eq.'gamtil')gamtil=sngl(val)
4149 if(linex(ix:jx).eq.'slopom')slopom=sngl(val)
4150 if(linex(ix:jx).eq.'slopoms')slopoms=sngl(val)
4151 if(linex(ix:jx).eq.'r2had(1)' )r2had(1)= sngl(val)
4152 if(linex(ix:jx).eq.'r2had(2)' )r2had(2)= sngl(val)
4153 if(linex(ix:jx).eq.'r2had(3)' )r2had(3)= sngl(val)
4154 if(linex(ix:jx).eq.'r2had(4)' )r2had(4)= sngl(val)
4155 if(linex(ix:jx).eq.'r2hads(1)' )r2hads(1)= sngl(val)
4156 if(linex(ix:jx).eq.'r2hads(2)' )r2hads(2)= sngl(val)
4157 if(linex(ix:jx).eq.'r2hads(3)' )r2hads(3)= sngl(val)
4158 if(linex(ix:jx).eq.'r2hads(4)' )r2hads(4)= sngl(val)
4159 if(linex(ix:jx).eq.'r3pom' )r3pom= sngl(val)
4160 if(linex(ix:jx).eq.'r4pom' )r4pom= sngl(val)
4161 if(linex(ix:jx).eq.'egyscr' )egyscr= sngl(val)
4162 if(linex(ix:jx).eq.'epscrw' )epscrw= sngl(val)
4163 if(linex(ix:jx).eq.'epscrx' )epscrx= sngl(val)
4164 if(linex(ix:jx).eq.'zbrads' )zbrads= sngl(val)
4165 if(linex(ix:jx).eq.'epscrs' )epscrs= sngl(val)
4166 if(linex(ix:jx).eq.'epscrh' )epscrh= sngl(val)
4167 if(linex(ix:jx).eq.'epscrp' )epscrp= sngl(val)
4168 if(linex(ix:jx).eq.'znurho' )znurho= sngl(val)
4169 if(linex(ix:jx).eq.'epscrd' )epscrd= sngl(val)
4170 if(linex(ix:jx).eq.'gfactor' )gfactor= sngl(val)
4171 if(linex(ix:jx).eq.'gwidth' )gwidth= sngl(val)
4172 if(linex(ix:jx).eq.'chad(1)' )chad(1)= sngl(val)
4173 if(linex(ix:jx).eq.'chad(2)' )chad(2)= sngl(val)
4174 if(linex(ix:jx).eq.'chad(3)' )chad(3)= sngl(val)
4175 if(linex(ix:jx).eq.'chad(4)' )chad(4)= sngl(val)
4176 if(linex(ix:jx).eq.'wdiff(1)')wdiff(1)=sngl(val)
4177 if(linex(ix:jx).eq.'wdiff(2)')wdiff(2)=sngl(val)
4178 if(linex(ix:jx).eq.'wdiff(3)')wdiff(3)=sngl(val)
4179 if(linex(ix:jx).eq.'wdiff(4)')wdiff(4)=sngl(val)
4180 if(linex(ix:jx).eq.'facdif') facdif=sngl(val)
4181 if(linex(ix:jx).eq.'facmc') facmc=sngl(val)
4182 if(linex(ix:jx).eq.'rexndf') rexndf=sngl(val)
4183 if(linex(ix:jx).eq.'rexndi(1)')rexndii(1)=sngl(val)
4184 if(linex(ix:jx).eq.'rexndi(2)')rexndii(2)=sngl(val)
4185 if(linex(ix:jx).eq.'rexndi(3)')rexndii(3)=sngl(val)
4186 if(linex(ix:jx).eq.'rexndi(4)')rexndii(4)=sngl(val)
4187 if(linex(ix:jx).eq.'rexdif(1)')rexdifi(1)=sngl(val)
4188 if(linex(ix:jx).eq.'rexdif(2)')rexdifi(2)=sngl(val)
4189 if(linex(ix:jx).eq.'rexdif(3)')rexdifi(3)=sngl(val)
4190 if(linex(ix:jx).eq.'rexdif(4)')rexdifi(4)=sngl(val)
4191 if(linex(ix:jx).eq.'rexpdif(1)')rexpdif(1)=sngl(val)
4192 if(linex(ix:jx).eq.'rexpdif(2)')rexpdif(2)=sngl(val)
4193 if(linex(ix:jx).eq.'rexpdif(3)')rexpdif(3)=sngl(val)
4194 if(linex(ix:jx).eq.'rexpdif(4)')rexpdif(4)=sngl(val)
4195 if(linex(ix:jx).eq.'rexres(1)')rexres(1)=sngl(val)
4196 if(linex(ix:jx).eq.'rexres(2)')rexres(2)=sngl(val)
4197 if(linex(ix:jx).eq.'rexres(3)')rexres(3)=sngl(val)
4198 if(linex(ix:jx).eq.'rexres(4)')rexres(4)=sngl(val)
4199 if(linex(ix:jx).eq.'zrminc')zrminc=sngl(val)
4200 if(linex(ix:jx).eq.'alpreg')alpreg=sngl(val)
4201 if(linex(ix:jx).eq.'sloreg')sloreg=sngl(val)
4202 if(linex(ix:jx).eq.'gamreg')gamreg=sngl(val)
4203 if(linex(ix:jx).eq.'r2reg' )r2reg= sngl(val)
4204 c if(linex(ix:jx).eq.'amhdibar')amhdibar= sngl(val)
4205 if(linex(ix:jx).eq.'ptdiff')ptdiff=sngl(val)
4206 if(linex(ix:jx).eq.'alppar')alppar=sngl(val)
4207 if(linex(ix:jx).eq.'alpsea')alpsea=sngl(val)
4208 if(linex(ix:jx).eq.'alpval')alpval=sngl(val)
4209 if(linex(ix:jx).eq.'alpdiq')alpdiq=sngl(val)
4210 if(linex(ix:jx).eq.'alplea(1)')alplea(1)=sngl(val)
4211 if(linex(ix:jx).eq.'alplea(2)')alplea(2)=sngl(val)
4212 if(linex(ix:jx).eq.'alplea(3)')alplea(3)=sngl(val)
4213 if(linex(ix:jx).eq.'alplea(4)')alplea(4)=sngl(val)
4214 if(linex(ix:jx).eq.'alpdif')alpdif=sngl(val)
4215 if(linex(ix:jx).eq.'alpdi')alpdi=sngl(val)
4216 if(linex(ix:jx).eq.'alpndi')alpndi=sngl(val)
4217 if(linex(ix:jx).eq.'ammsqq')ammsqq=sngl(val)
4218 if(linex(ix:jx).eq.'ammsqd')ammsqd=sngl(val)
4219 if(linex(ix:jx).eq.'ammsdd')ammsdd=sngl(val)
4220 if(linex(ix:jx).eq.'cumpom')cumpom=sngl(val)
4221 if(linex(ix:jx).eq.'reminv')reminv=sngl(val)
4222 if(linex(ix:jx).eq.'ptsend')ptsend=sngl(val)
4223 if(linex(ix:jx).eq.'ptsendi')ptsendi=sngl(val)
4224 if(linex(ix:jx).eq.'ptsems')ptsems=sngl(val)
4225 if(linex(ix:jx).eq.'zdrinc')zdrinc=sngl(val)
4226 if(linex(ix:jx).eq.'zmsinc')zmsinc=sngl(val)
4227 if(linex(ix:jx).eq.'edmaxi')edmaxi=sngl(val)
4228 if(linex(ix:jx).eq.'epmaxi')epmaxi=sngl(val)
4229 if(linex(ix:jx).eq.'zopinc')zopinc=sngl(val)
4230 if(linex(ix:jx).eq.'zipinc')zipinc=sngl(val)
4231 if(linex(ix:jx).eq.'fkainc')fkainc=sngl(val)
4232 if(linex(ix:jx).eq.'fkamax')fkamax=sngl(val)
4233 if(linex(ix:jx).eq.'zodinc')zodinc=sngl(val)
4234 if(linex(ix:jx).eq.'zbrmax')zbrmax=sngl(val)
4235 if(linex(ix:jx).eq.'zoeinc')zoeinc=sngl(val)
4236 if(linex(ix:jx).eq.'xmxrem')xmxrem=sngl(val)
4237 if(linex(ix:jx).eq.'ptsecu')ptsecu=sngl(val)
4238 if(linex(ix:jx).eq.'zdfinc')zdfinc=sngl(val)
4239 if(linex(ix:jx).eq.'zbcut') zbcut=sngl(val)
4240 if(linex(ix:jx).eq.'xzcut') xzcut=sngl(val)
4241 if(linex(ix:jx).eq.'xminremn')xminremn=sngl(val)
4242 if(linex(ix:jx).eq.'xmindiff')xmindiff=sngl(val)
4243 if(linex(ix:jx).eq.'alpdro(1)')alpdro(1)=sngl(val)
4244 if(linex(ix:jx).eq.'alpdro(2)')alpdro(2)=sngl(val)
4245 if(linex(ix:jx).eq.'alpdro(3)')alpdro(3)=sngl(val)
4246 if(linex(ix:jx).eq.'amdrmax')amdrmax=sngl(val)
4247 if(linex(ix:jx).eq.'amdrmin')amdrmin=sngl(val)
4248 if(linex(ix:jx).eq.'iodiba')iodiba=nint(val)
4249 if(linex(ix:jx).eq.'bidiba')bidiba=sngl(val)
4250
4251 c hard pomeron parameters
4252 if(linex(ix:jx).eq.'q2min' )q2min=sngl(val)
4253 if(linex(ix:jx).eq.'q2ini' )q2ini=sngl(val)
4254 if(linex(ix:jx).eq.'q2fin' )q2fin=sngl(val)
4255 if(linex(ix:jx).eq.'betpom')betpom=sngl(val)
4256 if(linex(ix:jx).eq.'alpfom')alpfomi=sngl(val)
4257 if(linex(ix:jx).eq.'betfom')betfom=dble(val)
4258 if(linex(ix:jx).eq.'gamfom')gamfom=dble(val)
4259 if(linex(ix:jx).eq.'glusea')glusea=sngl(val)
4260 if(linex(ix:jx).eq.'factk' )factk=sngl(val)
4261 if(linex(ix:jx).eq.'naflav')naflav=nint(val)
4262 if(linex(ix:jx).eq.'nrflav')nrflav=nint(val)
4263 if(linex(ix:jx).eq.'pt2cut')pt2cut=sngl(val)
4264 if(linex(ix:jx).eq.'factgam')factgam=sngl(val)
4265 if(linex(ix:jx).eq.'delh')delh=sngl(val)
4266 c nucleus-nucleus
4267 if(linex(ix:jx).eq.'iokoll')iokoll=nint(val)
4268 if(linex(ix:jx).eq.'laproj')laproj=nint(val)
4269 if(linex(ix:jx).eq.'maproj')maproj=nint(val)
4270 if(linex(ix:jx).eq.'latarg')latarg=nint(val)
4271 if(linex(ix:jx).eq.'matarg')matarg=nint(val)
4272 if(linex(ix:jx).eq.'core' )core =sngl(val)
4273 c if(linex(ix:jx).eq.'ncolmx')ncolmx=nint(val)
4274 if(linex(ix:jx).eq.'fctrmx')fctrmx=sngl(val)
4275 if(linex(ix:jx).eq.'bmaxim')bmaxim=sngl(val)
4276 if(linex(ix:jx).eq.'bminim')bminim=sngl(val)
4277 if(linex(ix:jx).eq.'phimax')phimax=sngl(val)
4278 if(linex(ix:jx).eq.'phimin')phimin=sngl(val)
4279 c rescattering parameters
4280 if(linex(ix:jx).eq.'iorsce')iorsce=nint(val)
4281 if(linex(ix:jx).eq.'iorsdf')iorsdf=nint(val)
4282 if(linex(ix:jx).eq.'iorshh')iorshh=nint(val)
4283 if(linex(ix:jx).eq.'iocluin')iocluin=nint(val)
4284 if(linex(ix:jx).eq.'ioquen')ioquen=nint(val)
4285 if(linex(ix:jx).eq.'iohole')iohole=nint(val)
4286 if(linex(ix:jx).eq.'fploss')fploss=sngl(val)
4287 if(linex(ix:jx).eq.'fvisco')fvisco=sngl(val)
4288 if(linex(ix:jx).eq.'fplmin')fplmin=sngl(val)
4289 if(linex(ix:jx).eq.'hacore')hacore=sngl(val)
4290 if(linex(ix:jx).eq.'amimfs')amimfs=sngl(val)
4291 if(linex(ix:jx).eq.'amimel')amimel=sngl(val)
4292 if(linex(ix:jx).eq.'cepara')cepara=sngl(val)
4293 if(linex(ix:jx).eq.'dscale')dscale=sngl(val)
4294 if(linex(ix:jx).eq.'iceopt')iceopt=nint(val)
4295 if(linex(ix:jx).eq.'delamf')delamf=sngl(val)
4296 if(linex(ix:jx).eq.'deuamf')deuamf=sngl(val)
4297 if(linex(ix:jx).eq.'taurea')taurea=sngl(val)
4298 if(linex(ix:jx).eq.'nsegsu')nsegsu=nint(val)
4299 if(linex(ix:jx).eq.'nsegce')nsegce=nint(val)
4300 if(linex(ix:jx).eq.'kigrid')kigrid=nint(val)
4301 if(linex(ix:jx).eq.'fsgrid')fsgrid=sngl(val)
4302 if(linex(ix:jx).eq.'ptclu') ptclu=sngl(val)
4303 if(linex(ix:jx).eq.'epscri(1)')epscri(1)=sngl(val)
4304 if(linex(ix:jx).eq.'epscri(3)')epscri(3)=sngl(val)
4305 if(linex(ix:jx).eq.'amsiac')amsiac=sngl(val)
4306 if(linex(ix:jx).eq.'amprif')amprif=sngl(val)
4307 if(linex(ix:jx).eq.'delvol')delvol=sngl(val)
4308 if(linex(ix:jx).eq.'deleps')deleps=sngl(val)
4309 if(linex(ix:jx).eq.'taumin')taumin=sngl(val)
4310 if(linex(ix:jx).eq.'deltau')deltau=sngl(val)
4311 if(linex(ix:jx).eq.'factau')factau=sngl(val)
4312 if(linex(ix:jx).eq.'numtau')numtau=nint(val)
4313 if(linex(ix:jx).eq.'dlzeta')dlzeta=sngl(val)
4314 if(linex(ix:jx).eq.'etafac')etafac=sngl(val)
4315 if(linex(ix:jx).eq.'facnuc')facnuc=sngl(val)
4316 c urqmd
4317 if(linex(ix:jx).eq.'iurqmd')iurqmd=int(val)
4318 c spherio
4319 if(linex(ix:jx).eq.'ispherio')ispherio=int(val)
4320 c ico
4321 if(linex(ix:jx).eq.'cutico') cutico=sngl(val)
4322 if(linex(ix:jx).eq.'dssico') dssico=sngl(val)
4323 if(linex(ix:jx).eq.'icocore')icocore=int(val)
4324 if(linex(ix:jx).eq.'icotabm')icotabm=int(val)
4325 if(linex(ix:jx).eq.'icotabr')icotabr=int(val)
4326 c droplet decay
4327 if(linex(ix:jx).eq.'dezzer')dezzer=sngl(val)
4328 if(linex(ix:jx).eq.'ioclude')ioclude=nint(val)
4329 if(linex(ix:jx).eq.'amuseg')amuseg=sngl(val)
4330 if(linex(ix:jx).eq.'yradmx')yradmx=sngl(val)
4331 if(linex(ix:jx).eq.'yradmi')yradmi=sngl(val)
4332 if(linex(ix:jx).eq.'yradpp')yradpp=sngl(val)
4333 if(linex(ix:jx).eq.'yradpi')yradpi=sngl(val)
4334 if(linex(ix:jx).eq.'yradpx')yradpx=sngl(val)
4335 if(linex(ix:jx).eq.'facecc')facecc=sngl(val)
4336 if(linex(ix:jx).eq.'rcoll' )rcoll= sngl(val)
4337 if(linex(ix:jx).eq.'ylongmx' )ylongmx= sngl(val)
4338 if(linex(ix:jx).eq.'bag4rt')bag4rt=sngl(val)
4339 if(linex(ix:jx).eq.'taunll')taunll=sngl(val)
4340 c droplet specification
4341 if(linex(ix:jx).eq. 'keu' )keu=nint(val)
4342 if(linex(ix:jx).eq. 'ked' )ked=nint(val)
4343 if(linex(ix:jx).eq. 'kes' )kes=nint(val)
4344 if(linex(ix:jx).eq. 'kec' )kec=nint(val)
4345 if(linex(ix:jx).eq. 'keb' )keb=nint(val)
4346 if(linex(ix:jx).eq. 'ket' )ket=nint(val)
4347 if(linex(ix:jx).eq. 'tecm' )tecm=sngl(val)
4348 if(linex(ix:jx).eq. 'volu' )volu=sngl(val)
4349 if(linex(ix:jx).eq. 'vrad' )vrad=sngl(val)
4350 if(linex(ix:jx).eq. 'facts')facts=sngl(val)
4351 if(linex(ix:jx).eq. 'factb')factb=sngl(val)
4352 if(linex(ix:jx).eq. 'factq')factq=sngl(val)
4353 if(linex(ix:jx).eq.'inbxxx')inbxxx=sngl(val)
4354 c metropolis
4355 if(linex(ix:jx).eq.'iospec')iospec=nint(val)
4356 if(linex(ix:jx).eq.'iocova')iocova=nint(val)
4357 if(linex(ix:jx).eq.'iopair')iopair=nint(val)
4358 if(linex(ix:jx).eq.'iozero')iozero=nint(val)
4359 if(linex(ix:jx).eq.'ioflac')ioflac=nint(val)
4360 if(linex(ix:jx).eq.'iostat')iostat=nint(val)
4361 if(linex(ix:jx).eq.'ioinco')ioinco=nint(val)
4362 if(linex(ix:jx).eq.'iograc')iograc=nint(val)
4363 if(linex(ix:jx).eq.'epsgc' )epsgc=sngl(val)
4364 if(linex(ix:jx).eq.'iocite')iocite=nint(val)
4365 if(linex(ix:jx).eq.'ioceau')ioceau=nint(val)
4366 if(linex(ix:jx).eq.'iociau')iociau=nint(val)
4367 if(linex(ix:jx).eq.'ioinct')ioinct=nint(val)
4368 if(linex(ix:jx).eq.'ioinfl')ioinfl=nint(val)
4369 if(linex(ix:jx).eq.'iowidn')iowidn=nint(val)
4370 if(linex(ix:jx).eq.'ionlat')ionlat=nint(val)
4371 if(linex(ix:jx).eq.'iomom')iomom=nint(val)
4372 if(linex(ix:jx).eq.'ioobsv')ioobsv=nint(val)
4373 if(linex(ix:jx).eq.'iosngl')iosngl=nint(val)
4374 if(linex(ix:jx).eq.'iorejz')iorejz=nint(val)
4375 if(linex(ix:jx).eq.'iompar')iompar=nint(val)
4376 if(linex(ix:jx).eq.'iozinc')iozinc=nint(val)
4377 if(linex(ix:jx).eq.'iozevt')iozevt=nint(val)
4378 if(linex(ix:jx).eq. 'nadd' )nadd=nint(val)
4379 if(linex(ix:jx).eq.'iterma')iterma=nint(val)
4380 if(linex(ix:jx).eq.'itermx')stop'STOP: set iterma, not itermx'
4381 if(linex(ix:jx).eq.'iterpr')iterpr=nint(val)
4382 if(linex(ix:jx).eq.'iterpl')iterpl=nint(val)
4383 if(linex(ix:jx).eq.'iternc')iternc=nint(val)
4384 if(linex(ix:jx).eq.'epsr' )epsr=sngl(val)
4385 if(linex(ix:jx).eq.'keepr' )keepr=nint(val)
4386 c strangelets
4387 if(linex(ix:jx).eq.'iopenu')iopenu=nint(val)
4388 if(linex(ix:jx).eq.'themas')themas=sngl(val)
4389 c tests
4390 if(linex(ix:jx).eq.'iotst1')iotst1=nint(val)
4391 if(linex(ix:jx).eq.'iotst2')iotst2=nint(val)
4392 if(linex(ix:jx).eq.'iotst3')iotst3=nint(val)
4393 if(linex(ix:jx).eq.'iotst4')iotst4=nint(val)
4394 c jpsi
4395 if(linex(ix:jx).eq.'jpsi ')jpsi =nint(val)
4396 if(linex(ix:jx).eq.'jpsifi')jpsifi=nint(val)
4397 if(linex(ix:jx).eq.'sigj ')sigj =sngl(val)
4398 if(linex(ix:jx).eq.'taumx ')taumx =sngl(val)
4399 if(linex(ix:jx).eq.'nsttau')nsttau=nint(val)
4400 if(linex(ix:jx).eq.'ijphis')ijphis=nint(val)
4401 c analysis: intermittency, space-time, droplets, formation time
4402 if(linex(ix:jx).eq.'ymximi')ymximi=sngl(val)
4403 if(linex(ix:jx).eq.'imihis')imihis=nint(val)
4404 if(linex(ix:jx).eq.'isphis')isphis=nint(val)
4405 if(linex(ix:jx).eq.'iologb')iologb=nint(val)
4406 if(linex(ix:jx).eq.'ispall')ispall=nint(val)
4407 if(linex(ix:jx).eq.'wtmini')wtmini=sngl(val)
4408 if(linex(ix:jx).eq.'wtstep')wtstep=sngl(val)
4409 if(linex(ix:jx).eq.'iwcent')iwcent=nint(val)
4410 if(linex(ix:jx).eq.'iclhis')iclhis=nint(val)
4411 if(linex(ix:jx).eq.'iwtime')iwtime=nint(val)
4412 if(linex(ix:jx).eq.'wtimet')wtimet=sngl(val)
4413 if(linex(ix:jx).eq.'wtimei')wtimei=sngl(val)
4414 if(linex(ix:jx).eq.'wtimea')wtimea=sngl(val)
4415 c other
4416 if(linex(ix:jx).eq.'gaumx ')gaumx =sngl(val)
4417 if(linex(ix:jx).eq.'nclean')nclean=nint(val)
4418 if(linex(ix:jx).eq.'istore')istore=nint(val)
4419 if(linex(ix:jx).eq.'ioidch')ioidch=nint(val)
4420 if(linex(ix:jx).eq.'iframe')iframe=nint(val)
4421 if(linex(ix:jx).eq.'jframe')jframe=nint(val)
4422 if(linex(ix:jx).eq.'labsys')stop'labsys no longer supported'
4423 if(linex(ix:jx).eq.'irescl')irescl=nint(val)
4424 if(linex(ix:jx).eq.'iremn')iremn=nint(val)
4425 if(linex(ix:jx).eq.'ifrade')ifrade=nint(val)
4426 if(linex(ix:jx).eq.'idecay')idecay=nint(val)
4427 if(linex(ix:jx).eq.'jdecay')jdecay=nint(val)
4428 if(linex(ix:jx).eq.'ntrymx')ntrymx=nint(val)
4429 if(linex(ix:jx).eq.'istmax')istmax=nint(val)
4430 if(linex(ix:jx).eq.'ionudi')ionudi=nint(val)
4431 if(linex(ix:jx).eq.'seedi') seedi =val
4432 if(linex(ix:jx).eq.'seedj') seedj =val
4433 if(linex(ix:jx).eq.'seedf') seedj2=val
4434 if(linex(ix:jx).eq.'normal')normal=nint(val)
4435 if(linex(ix:jx).eq.'xminim')xminim=sngl(val)
4436 if(linex(ix:jx).eq.'xmaxim')xmaxim=sngl(val)
4437 if(linex(ix:jx).eq.'nrbins')nrbins=nint(val)
4438 if(linex(ix:jx).eq.'hisfac')hisfac=sngl(val)
4439 if(linex(ix:jx).eq.'xshift')xshift=sngl(val)
4440 if(linex(ix:jx).eq.'etacut')etacut=sngl(val)
4441 if(linex(ix:jx).eq.'xpar1' )xpar1=sngl(val)
4442 if(linex(ix:jx).eq.'xpar2' )xpar2=sngl(val)
4443 if(linex(ix:jx).eq.'xpar3' )xpar3=sngl(val)
4444 if(linex(ix:jx).eq.'xpar4' )xpar4=sngl(val)
4445 if(linex(ix:jx).eq.'xpar5' )xpar5=sngl(val)
4446 if(linex(ix:jx).eq.'xpar6' )xpar6=sngl(val)
4447 if(linex(ix:jx).eq.'xpar7' )xpar7=sngl(val)
4448 if(linex(ix:jx).eq.'xpar8' )xpar8=sngl(val)
4449 if(linex(ix:jx).eq.'irdmpr')irdmpr=nint(val)
4450 if(linex(ix:jx).eq.'ilprtg')ilprtg=nint(val)
4451 if(linex(ix:jx).eq.'iLHC')then
4452 if(nint(val).eq.1)call LHCparameters
4453 endif
4454 c frame definitions
4455 if(linex(ix:jx).eq.'engy'.and.iframe.eq.0)iframe=11
4456 if(linex(ix:jx).eq.'ecms'.and.iframe.eq.0)iframe=11
4457 if(linex(ix:jx).eq.'elab'.and.iframe.eq.0)iframe=12
4458 if(linex(ix:jx).eq.'ekin'.and.iframe.eq.0)iframe=12
4459 if(linex(ix:jx).eq.'pnll'.and.iframe.eq.0)iframe=12
4460 if(linex(ix:jx).eq.'ebeam'.and.iframe.eq.0)iframe=21
4461 if(linex(ix:jx).eq.'noebin'.and.dabs(val-1.d0).gt.1.d-10)iframe=11
4462 endif
4463
4464 elseif(line(i:j).eq.'set')then
4465
4466 call utword(line,i,j,0)
4467 call utword(line,i,j,0)
4468 ifset=1
4469
4470 elseif(line(i:j).eq.'stop')then !same as return
4471
4472 if(nopen.ne.-1)then
4473 close(20+nopen)
4474 nopen=nopen-1
4475 if(nopen.eq.0.and.iprmpt.eq.-1)iprmpt=1
4476 endif
4477
4478 elseif(line(i:j).eq.'stopprogram')then
4479
4480 close(unit=ifcx)
4481 close(unit=ifhi)
4482 close(unit=ifdt)
4483 stop
4484
4485 elseif(line(i:j).eq.'EndEposInput')then
4486
4487 return
4488
4489 elseif(line(i:j).eq.'string')then
4490
4491 nstmax=nstmax+1
4492 ns=nstmax
4493 icinpu=0
4494 call utworn(line,j,ne)
4495 if(ne.eq.0.and.iprmpt.gt.0)
4496 *write(ifmt,'(a)')'string: prob icbac1 icbac2 icfor1 icfor2?'
4497 call utword(line,i,j,0)
4498 read(line(i:j),*)val
4499 prob(ns)=sngl(val)
4500 call utworn(line,j,ne)
4501 if(ne.eq.0.and.iprmpt.gt.0)
4502 *write(ifmt,'(a)')'string: icbac1 icbac2 icfor1 icfor2?'
4503 call utword(line,i,j,0)
4504 read(line(i:j),*)val
4505 icbac(ns,1)=nint(val)
4506 call utworn(line,j,ne)
4507 if(ne.eq.0.and.iprmpt.gt.0)
4508 *write(ifmt,'(a)')'string: icbac2 icfor1 icfor2?'
4509 call utword(line,i,j,0)
4510 read(line(i:j),*)val
4511 icbac(ns,2)=nint(val)
4512 call utworn(line,j,ne)
4513 if(ne.eq.0.and.iprmpt.gt.0)
4514 *write(ifmt,'(a)')'string: icfor1 icfor2?'
4515 call utword(line,i,j,0)
4516 read(line(i:j),*)val
4517 icfor(ns,1)=nint(val)
4518 call utworn(line,j,ne)
4519 if(ne.eq.0.and.iprmpt.gt.0)
4520 *write(ifmt,'(a)')'string: icfor2?'
4521 call utword(line,i,j,0)
4522 read(line(i:j),*)val
4523 icfor(ns,2)=nint(val)
4524
4525 elseif(line(i:j).eq.'kinks')then
4526
4527 nptl=0
4528 ctp290806 nrow=0
4529 nel=0
4530 10 continue
4531 call utword(line,i,j,0)
4532 if(line(i:j).eq.'endkinks')goto 12
4533 nel=nel+1
4534 ctp290806 nrow=1+(nel-1)/4
4535 nc=mod(nel-1,4)+1
4536 read(line(i:j),*)a
4537 if(nc.eq.1)nptl=nptl+1
4538 if(nc.eq.1)idptl(nptl)=nint(a)
4539 if(nc.eq.2)pptl(1,nptl)=a
4540 if(nc.eq.3)pptl(2,nptl)=a
4541 if(nc.eq.4)then
4542 pptl(3,nptl)=a
4543 istptl(nptl)=20
4544 pptl(4,nptl)=sqrt(pptl(3,nptl)**2+pptl(2,nptl)**2
4545 $ +pptl(1,nptl)**2)
4546 endif
4547 goto 10
4548 12 continue
4549
4550 elseif(line(i:j).eq.'record')then
4551
4552 call utworn(line,j,ne)
4553 c if(ne.eq.0.and.iprmpt.gt.0)
4554 c * write(ifmt,'(a)')'kinks: icbac1 icbac2 icfor1 icfor2?'
4555 call utword(line,i,j,0)
4556 ir=0
4557 if(line(i:j).eq.'event')then
4558 ir=1
4559 elseif(line(i:j).eq.'particle')then
4560 ir=2
4561 else
4562 call utstop("Wrong definition for record!&")
4563 endif
4564 maxrec(ir)=0
4565 20 call utworn(line,j,ne)
4566 c if(ne.eq.0.and.iprmpt.gt.0)
4567 c * write(6,'(a)')'<kinks-data (px-py-pz)>? (End=endkinks)'
4568 call utword(line,i,j,0)
4569 if(line(i:j).eq.'endrecord')then
4570 goto 22
4571 endif
4572 maxrec(ir)=maxrec(ir)+1
4573 irecty(maxrec(ir),ir)=-1
4574 if(ir.eq.1)then
4575 if(line(i:j).eq.'0') irecty(maxrec(ir),ir)=0
4576 if(line(i:j).eq.'nevt') irecty(maxrec(ir),ir)=1
4577 if(line(i:j).eq.'nptl') irecty(maxrec(ir),ir)=2
4578 if(line(i:j).eq.'b') irecty(maxrec(ir),ir)=3
4579 if(line(i:j).eq.'phi') irecty(maxrec(ir),ir)=4
4580 if(line(i:j).eq.'ncol') irecty(maxrec(ir),ir)=5
4581 if(line(i:j).eq.'pmx') irecty(maxrec(ir),ir)=6
4582 if(line(i:j).eq.'egy') irecty(maxrec(ir),ir)=7
4583 if(line(i:j).eq.'npj') irecty(maxrec(ir),ir)=8
4584 if(line(i:j).eq.'ntg') irecty(maxrec(ir),ir)=9
4585 if(line(i:j).eq.'npn') irecty(maxrec(ir),ir)=10
4586 if(line(i:j).eq.'npp') irecty(maxrec(ir),ir)=11
4587 if(line(i:j).eq.'ntn') irecty(maxrec(ir),ir)=12
4588 if(line(i:j).eq.'ntp') irecty(maxrec(ir),ir)=13
4589 if(line(i:j).eq.'jpn') irecty(maxrec(ir),ir)=14
4590 if(line(i:j).eq.'jpp') irecty(maxrec(ir),ir)=15
4591 if(line(i:j).eq.'jtn') irecty(maxrec(ir),ir)=16
4592 if(line(i:j).eq.'jtp') irecty(maxrec(ir),ir)=17
4593 if(line(i:j).eq.'amp') irecty(maxrec(ir),ir)=20
4594 if(line(i:j).eq.'amt') irecty(maxrec(ir),ir)=21
4595 if(line(i:j).eq.'qsq') irecty(maxrec(ir),ir)=22
4596 if(line(i:j).eq.'xbj') irecty(maxrec(ir),ir)=23
4597 if(line(i:j).eq.'typ') irecty(maxrec(ir),ir)=24
4598 else
4599 if(line(i:j).eq.'0') irecty(maxrec(ir),ir)=0
4600 if(line(i:j).eq.'i') irecty(maxrec(ir),ir)=1
4601 if(line(i:j).eq.'id') irecty(maxrec(ir),ir)=2
4602 if(line(i:j).eq.'p1') irecty(maxrec(ir),ir)=3
4603 if(line(i:j).eq.'p2') irecty(maxrec(ir),ir)=4
4604 if(line(i:j).eq.'p3') irecty(maxrec(ir),ir)=5
4605 if(line(i:j).eq.'p4') irecty(maxrec(ir),ir)=6
4606 if(line(i:j).eq.'p5') irecty(maxrec(ir),ir)=7
4607 if(line(i:j).eq.'fa') irecty(maxrec(ir),ir)=8
4608 if(line(i:j).eq.'mo') irecty(maxrec(ir),ir)=9
4609 if(line(i:j).eq.'st') irecty(maxrec(ir),ir)=10
4610 if(line(i:j).eq.'x1') irecty(maxrec(ir),ir)=11
4611 if(line(i:j).eq.'x2') irecty(maxrec(ir),ir)=12
4612 if(line(i:j).eq.'x3') irecty(maxrec(ir),ir)=13
4613 if(line(i:j).eq.'x4') irecty(maxrec(ir),ir)=14
4614 if(line(i:j).eq.'idfa') irecty(maxrec(ir),ir)=15
4615 if(line(i:j).eq.'idmo') irecty(maxrec(ir),ir)=16
4616 if(line(i:j).eq.'p') irecty(maxrec(ir),ir)=17
4617 if(line(i:j).eq.'x') irecty(maxrec(ir),ir)=18
4618 if(line(i:j).eq.'dez') irecty(maxrec(ir),ir)=19
4619 if(line(i:j).eq.'c1') irecty(maxrec(ir),ir)=21
4620 if(line(i:j).eq.'c2') irecty(maxrec(ir),ir)=22
4621 if(line(i:j).eq.'ty') irecty(maxrec(ir),ir)=23
4622 endif
4623 if(irecty(maxrec(ir),ir).eq.-1)then
4624 write(*,*) 'unknown variable ',line(i:j)
4625 stop
4626 endif
4627 goto 20
4628 22 continue
4629
4630 elseif(line(i:j).eq.'switch')then
4631
4632 call utworn(line,j,ne)
4633 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'option on/off?'
4634 call utword(line,i,j,0)
4635 call utworn(line,j,ne)
4636 if(ne.eq.0.and.iprmpt.gt.0)write(ifmt,'(a)')'on/off?'
4637 if(line(i:j).eq.'droplet')then
4638 call utword(line,i,j,0)
4639 if(line(i:j).eq.'on' )iorsdf=1
4640 if(line(i:j).eq.'off')iorsdf=0
4641 elseif(line(i:j).eq.'cascade')then
4642 call utword(line,i,j,0)
4643 c if(line(i:j).eq.'on' )iorsce=1
4644 if(line(i:j).eq.'on' )iorshh=1
4645 c if(line(i:j).eq.'off')iorsce=0
4646 if(line(i:j).eq.'off')iorshh=0
4647 elseif(line(i:j).eq.'soft')then
4648 call utword(line,i,j,0)
4649 if(line(i:j).eq.'on' )isopom=1
4650 if(line(i:j).eq.'off')isopom=0
4651 elseif(line(i:j).eq.'hard')then
4652 call utword(line,i,j,0)
4653 if(line(i:j).eq.'on' )ishpom=1
4654 if(line(i:j).eq.'off')ishpom=0
4655 elseif(line(i:j).eq.'splitting')then
4656 call utword(line,i,j,0)
4657 if(line(i:j).eq.'on' )isplit=1
4658 if(line(i:j).eq.'on' )iscreen=1
4659 if(line(i:j).eq.'off')isplit=0
4660 if(line(i:j).eq.'off')iscreen=0
4661 elseif(line(i:j).eq.'fusion')then
4662 call utword(line,i,j,0)
4663 if(line(i:j).eq.'on' )iorsce=0
4664 if(line(i:j).eq.'on' )iorsdf=3
4665 if(line(i:j).eq.'on' )iorshh=0
4666 if(line(i:j).eq.'off')iorsce=0
4667 if(line(i:j).eq.'off')iorsdf=0
4668 if(line(i:j).eq.'off')iorshh=0
4669 elseif(line(i:j).eq.'urqmd')then
4670 call utword(line,i,j,0)
4671 if(line(i:j).eq.'on' ) iurqmd=1
4672 if(line(i:j).eq.'off') iurqmd=0
4673 elseif(line(i:j).eq.'spherio')then
4674 call utword(line,i,j,0)
4675 if(line(i:j).eq.'on' ) ispherio=1
4676 if(line(i:j).eq.'off') ispherio=0
4677 elseif(line(i:j).eq.'decay')then
4678 call utword(line,i,j,0)
4679 if(line(i:j).eq.'on' ) ndecay=0
4680 if(line(i:j).eq.'off') ndecay=1
4681 if(line(i:j).eq.'on' ) idecay=1
4682 if(line(i:j).eq.'off') idecay=0
4683 elseif(line(i:j).eq.'clusterdecay')then
4684 call utword(line,i,j,0)
4685 if(line(i:j).eq.'on' ) jdecay=1
4686 if(line(i:j).eq.'off') jdecay=0
4687 elseif(line(i:j).eq.'fragdecay')then
4688 call utword(line,i,j,0)
4689 if(line(i:j).eq.'on' ) ifrade=1
4690 if(line(i:j).eq.'off') ifrade=0
4691 elseif(line(i:j).eq.'icocore')then
4692 stop'switch icocore not supported any more. '
4693 endif
4694
4695 elseif(line(i:j).eq.'idchoice')then
4696
4697 call utword(line,i,j,0)
4698 if(line(i:j).eq.'nxs')then
4699 ioidch=1
4700 elseif(line(i:j).eq.'pdg')then
4701 ioidch=2
4702 else
4703 stop'invalid idchoice. '
4704 endif
4705
4706 elseif(line(i:j).eq.'make')then
4707
4708 call utword(line,i,j,0)
4709 if(line(i:j).eq.'icotable')icotabm=1
4710
4711 elseif(line(i:j).eq.'read')then
4712
4713 call utword(line,i,j,0)
4714 if(line(i:j).eq.'icotable')icotabr=1
4715
4716 elseif(line(i:j).eq.'output')then
4717
4718 call utword(line,i,j,0)
4719 if(line(i:j).eq.'full' ) istore=-1
4720 if(line(i:j).eq.'epos' ) istore=1
4721 if(line(i:j).eq.'osc1997a' ) istore=2
4722 if(line(i:j).eq.'osc1999a' ) istore=3
4723 if(line(i:j).eq.'lhef' ) istore=4
4724 if(line(i:j).eq.'ustore' ) istore=5
4725 if(line(i:j).eq.'hepmc' ) istore=6
4726
4727 elseif(line(i:j).eq.'model')then
4728
4729 call utword(line,i,j,0)
4730 if(line(i:j).eq.'epos')then
4731 model=1
4732 elseif(line(i:j).eq.'lhc'.or.line(i:j).eq.'LHC')then
4733 model=1
4734 call LHCparameters
4735 else
4736 nij=j-i+1
4737 if(nij.gt.20)stop'cmodel too small'
4738 cmodel(1:nij)=line(i:j)
4739 cmodel(nij+1:nij+1)=' '
4740 call NumberModel(cmodel,model)
4741 endif
4742 if(abs(iappl).ne.1.and.iappl.ne.3.and.model.ne.1
4743 &.and..not.(model.eq.4.and.iappl.eq.7))
4744 &call utstop('Application not possible with this model&')
4745
4746 elseif(line(i:j).eq.'trigger')then
4747
4748 call utword(line,i,j,0)
4749 ntc=1
4750 if(line(i:j).eq.'or'.or.line(i:j).eq.'contr')then
4751 call utword(line,i,j,0)
4752 read(line(i:j),*)ztc
4753 ntc=nint(ztc)
4754 call utword(line,i,j,1)
4755 endif
4756 do n=1,ntc
4757 if(n.ne.1)call utword(line,i,j,0)
4758 call utword(line,i,j,0)
4759 call utword(line,i,j,0)
4760 enddo
4761
4762 elseif(line(i:j).eq.'noerrorbut')then
4763
4764 call utword(line,i,j,0)
4765
4766 elseif(line(i:j).eq.'b')then
4767
4768 nbarray=nbarray+1
4769 call utword(line,i,j,0)
4770 read(line(i:j),*)val
4771 barray(nbarray)=val
4772
4773 elseif(line(i:j).eq.'message')then
4774
4775 call utword(line,i,j,0)
4776 if(nopen.eq.-1)then !only write in second read
4777 write(ifmt,'(a,$)')line(i:j)
4778 endif
4779
4780 elseif(line(i:j).eq.'endmessage')then
4781
4782 if(nopen.eq.-1)then !only write in second read
4783 write(ifmt,'(a)')' '
4784 endif
4785
4786 elseif(line(i:j).eq.'write'.or.line(i:j).eq.'writex')then
4787
4788 ii=0
4789 if(line(i:j).eq.'write')then
4790 ii=1
4791 elseif(line(i:j).eq.'writex')then
4792 ii=2
4793 else
4794 call utstop("Wrong definition for write!&")
4795 endif
4796 call utword(line,i,j,0)
4797 idol=0
4798 if(line(i:j).eq.'$')then
4799 idol=1
4800 call utword(line,i,j,0)
4801 endif
4802 !write: only write in second read; writex: only write in first read
4803 if(ii.eq.1.and.nopen.eq.-1.or.ii.eq.2.and.nopen.ne.-1)then
4804 if(j-4.ge.i)then
4805 do l=i,j-4
4806 if(line(l:l+4).eq.'$hydt')then
4807 line(l+3:l+4)=' '
4808 write(line(l:l+2),'(a)')hydt
4809 endif
4810 enddo
4811 endif
4812 if(j-6.ge.i)then
4813 do l=i,j-6
4814 if(line(l:l+6).eq.'$iversn')then
4815 if(mod(iversn,100).le.9)then
4816 write(line(l:l+6),'(i1,a,i1,3x)')
4817 * int(iversn/100),'.0',mod(iversn,100)
4818 else
4819 write(line(l:l+6),'(i1,a,i2,3x)')
4820 * int(iversn/100),'.',mod(iversn,100)
4821 endif
4822 endif
4823 enddo
4824 endif
4825 if(j-8.ge.i)then
4826 do l=i,j-8
4827 if(line(l:l+8).eq.'$xxxyield')then
4828 write(line(l:l+8),'(f8.6,1x)')yield
4829 endif
4830 if(line(l:l+7).eq.'$xxyield')then
4831 write(line(l:l+8),'(f7.5,1x)')yield
4832 endif
4833 if(line(l:l+6).eq.'$xyield')then
4834 write(line(l:l+8),'(f6.4,1x)')yield
4835 endif
4836 enddo
4837 endif
4838 if(j-5.ge.i)then
4839 do l=i,j-5
4840 if(line(l:l+5).eq.'$yield')then
4841 if(yield.lt.1.0)then
4842 write(line(l:l+5),'(f5.3,1x)')yield
4843 elseif(yield.lt.100.)then
4844 write(line(l:l+5),'(f5.2,1x)')yield
4845 elseif(yield.lt.1000.)then
4846 write(line(l:l+5),'(f5.1,1x)')yield
4847 elseif(yield.lt.10000.)then
4848 write(line(l:l+5),'(f6.1)')yield
4849 else
4850 write(line(l:l+5),'(i6)')nint(yield)
4851 endif
4852 endif
4853 enddo
4854 do l=i,j-5
4855 if(line(l:l+5).eq.'$averg')then
4856 if(averg.lt.1.0)then
4857 write(line(l:l+5),'(f5.3,1x)')averg
4858 elseif(averg.lt.100.)then
4859 write(line(l:l+5),'(f5.2,1x)')averg
4860 elseif(averg.lt.1000.)then
4861 write(line(l:l+5),'(f5.1,1x)')averg
4862 elseif(averg.lt.10000.)then
4863 write(line(l:l+5),'(f6.1)')averg
4864 else
4865 write(line(l:l+5),'(i6)')nint(averg)
4866 endif
4867 endif
4868 enddo
4869 do l=i,j-5
4870 if(line(l:l+5).eq.'$sigma')then
4871 if(sigma.lt.1.0)then
4872 write(line(l:l+5),'(f5.3,1x)')sigma
4873 elseif(sigma.lt.100.)then
4874 write(line(l:l+5),'(f5.2,1x)')sigma
4875 elseif(sigma.lt.1000.)then
4876 write(line(l:l+5),'(f5.1,1x)')sigma
4877 elseif(sigma.lt.10000.)then
4878 write(line(l:l+5),'(f6.1)')sigma
4879 else
4880 write(line(l:l+5),'(i6)')nint(sigma)
4881 endif
4882 endif
4883 enddo
4884 endif
4885 if(idol.eq.0)then
4886 write(ifhi,'(a)')line(i:j)
4887 else
4888 write(ifhi,'(a,a,$)')line(i:j),' '
4889 endif
4890 endif
4891
4892 elseif(line(i:j).eq.'nozero')then
4893
4894 nozero=1
4895
4896 elseif(line(i:j).eq.'ibmin')then
4897
4898 call utword(line,i,j,0)
4899 read(line(i:j),*)val
4900 ibmin=nint(val)
4901
4902 elseif(line(i:j).eq.'ibmax')then
4903
4904 call utword(line,i,j,0)
4905 read(line(i:j),*)val
4906 ibmax=nint(val)
4907
4908 elseif(line(i:j).eq.'writearray'
4909 $ .or.line(i:j).eq.'writehisto')then
4910
4911 if(nopen.eq.-1)then !second run
4912 ih=0
4913 if(line(i:j).eq.'writearray') ih=1
4914 call utword(line,i,j,0)
4915 if(line(i:j).eq.'s')then
4916 call utword(line,i,j,0)
4917 linex=line
4918 ix=i
4919 jx=j
4920 call utword(line,i,j,0)
4921 if(linex(ix:jx).eq.'inicon')stop'error 060307'
4922 else
4923 ioint=0
4924 iocontr=0
4925 ncontr=0
4926 if(line(i:j).eq.'int')then
4927 ioint=1
4928 call utword(line,i,j,0)
4929 endif
4930 if(line(i:j).eq.'contr')then
4931 iocontr=1
4932 call utword(line,i,j,0)
4933 read(line(i:j),*)val
4934 ncontr=nint(val)
4935 call utword(line,i,j,0)
4936 endif
4937 read(line(i:j),*)val
4938 nco=nint(val)
4939 if(ih.eq.1)write(ifhi,'(a,i3)')'array',nco
4940 if(ioint.eq.0)then
4941 sum=0
4942 averg=0
4943 do k=1,nrbins
4944 if(iocontr.eq.0.and.ionoerr.eq.0)then
4945 ar3=ar(k,3)
4946 ar4=ar(k,4)
4947 elseif(ionoerr.eq.1)then
4948 ar3=ar(k,3)
4949 ar4=ar(k,4)
4950 elseif(ionoerr.eq.2)then
4951 ar3=ar(k,3)
4952 ar4=ar(k,4)
4953 ar5=ar(k,5)
4954 else
4955 ar3=ary(k,ncontr)
4956 ar4=ardy(k,ncontr)
4957 endif
4958 iok=1
4959 if(k.lt.ibmin.or.k.gt.ibmax)iok=0
4960 sum=sum+ar3
4961 averg=averg+ar(k,1)*ar3
4962 if(nco.eq.2)then
4963 if(nozero.eq.1.and.ar3.eq.0.)iok=0
4964 if(iok.eq.1)write(ifhi,'(3e12.4)')ar(k,1),ar3
4965 elseif(nco.eq.3)then
4966 if(nozero.eq.1.and.ar3.eq.0..and.ar4.eq.0.)iok=0
4967 if(iok.eq.1)write(ifhi,'(3e12.4)')ar(k,1),ar3,ar4
4968 elseif(nco.eq.4)then
4969 if(nozero.eq.1.and.ar3.eq.0..and.ar4.eq.0..and.ar5.eq.0.)iok=0
4970 if(iok.eq.1)write(ifhi,'(4e12.4)')ar(k,1),ar3,ar4,ar5
4971 endif
4972 enddo
4973 if(sum.gt.0.)averg=averg/sum
4974 else
4975 sum=0.
4976 sum2=0.
4977 sum3=0.
4978 err2=0.
4979 do k=1,nrbins
4980 if(iocontr.eq.0.and.ionoerr.eq.0)then
4981 ar3=ar(k,3)
4982 ar4=ar(k,4)
4983 elseif(ionoerr.eq.1)then
4984 ar3=ar(k,3)
4985 ar4=ar(k,4)
4986 elseif(ionoerr.eq.2)then
4987 ar3=ar(k,3)
4988 ar4=ar(k,4)
4989 ar5=ar(k,5)
4990 else
4991 ar3=ary(k,ncontr)
4992 ar4=ardy(k,ncontr)
4993 endif
4994 sum=sum+ar3*(ar(2,1)-ar(1,1))
4995 if(nco.eq.2)write(ifhi,'(3e12.4)')ar(k,1),sum
4996 if(ionoerr.eq.0)then
4997 err2=err2+(ar4*(ar(2,1)-ar(1,1)))**2
4998 if(nco.eq.3)write(ifhi,'(3e12.4)')ar(k,1),sum,sqrt(err2)
4999 elseif(ionoerr.eq.1)then
5000 sum2=sum2+(ar4*(ar(2,1)-ar(1,1)))
5001 if(nco.eq.3)write(ifhi,'(3e12.4)')ar(k,1),sum,sum2
5002 elseif(ionoerr.eq.2)then
5003 sum2=sum2+(ar4*(ar(2,1)-ar(1,1)))
5004 sum3=sum3+(ar5*(ar(2,1)-ar(1,1)))
5005 if(nco.eq.3)write(ifhi,'(3e12.4)')ar(k,1),sum,sum2
5006 if(nco.eq.4)write(ifhi,'(3e12.4)')ar(k,1),sum,sum2,sum3
5007 endif
5008 enddo
5009 endif
5010 if(ih.eq.1)write(ifhi,'(a)')' endarray'
5011 endif
5012 else !nopen .ge. 0 -- first run
5013 call utword(line,i,j,0)
5014 if(line(i:j).eq.'s')then
5015 call utword(line,i,j,0)
5016 call utword(line,i,j,0)
5017 elseif(line(i:j).eq.'int')then
5018 call utword(line,i,j,0)
5019 elseif(line(i:j).eq.'contr')then
5020 call utword(line,i,j,0)
5021 call utword(line,i,j,0)
5022 endif
5023 endif
5024 nozero=0
5025 ibmin=1
5026 ibmax=1e8
5027
5028 else
5029
5030 write(ifmt,'(a,a,a)')'command "',line(i:j),'" not found'
5031 j=1000
5032 stop
5033
5034 endif
5035
5036 i=j+1
5037 goto 1
5038
5039 end
5040
5041 c-----------------------------------------------------------------------
5042 subroutine aseed(modus)
5043 c-----------------------------------------------------------------------
5044
5045 include 'epos.inc'
5046 double precision seedf
5047 call utpri('aseed ',ish,ishini,3)
5048
5049 call ranfgt(seedf)
5050 if(iwseed.eq.1)then
5051 if(nrevt.eq.0)then
5052 c write(ifmt,'(a,i10,d27.16)')'seedj:',nint(seedj),seedf
5053 elseif(mod(nrevt,modsho).eq.0)then
5054 if(modus.eq.1)
5055 * write(ifmt,'(a,i10,5x,a,i10,a,d27.16)')
5056 * 'nrevt:',nrevt,'seedj:',nint(seedj),' seedf:',seedf
5057 if(modus.eq.2)
5058 * write(ifmt,'(a,i10,d27.16)')'seed:',nint(seedj),seedf
5059 endif
5060 if(jwseed.eq.1)then
5061 open(unit=1,file=fnch(1:nfnch-5)//'see',status='unknown')
5062 write(1,'(a,i10,5x,a,i10,a,d27.16)')
5063 * 'nrevt:',nrevt,'seedj:',nint(seedj),' seedf:',seedf
5064 close(1)
5065 endif
5066 endif
5067 seedc=seedf
5068
5069 call utprix('aseed ',ish,ishini,3)
5070 return
5071 end
5072
5073 c-----------------------------------------------------------------------
5074 subroutine aseedi
5075 c-----------------------------------------------------------------------
5076
5077 include 'epos.inc'
5078 call utpri('aseedi',ish,ishini,3)
5079
5080 if(ish.ge.1)write(ifmt,'(a,i10)')'seedi:',nint(seedi)
5081
5082 call utprix('aseedi',ish,ishini,3)
5083 return
5084 end
5085
5086 c$$$c-----------------------------------------------------------------------
5087 c$$$ subroutine aseed(modus) !Flush ????
5088 c$$$c-----------------------------------------------------------------------
5089 c$$$
5090 c$$$ include 'epos.inc'
5091 c$$$ double precision seedf
5092 c$$$ call utpri('aseed',ish,ishini,4)
5093 c$$$
5094 c$$$ call ranfgt(seedf)
5095 c$$$ if(modus.eq.2)then
5096 c$$$ write(ifmt,'(a,d26.15)')'seed:',seedf
5097 c$$$ elseif(modus.eq.1)then
5098 c$$$ if(mod(nrevt,modsho).eq.0)then
5099 c$$$ write(ifmt,100)'nrevt:',nrevt,'seedf:',seedf
5100 c$$$ call flush(ifmt)
5101 c$$$ endif
5102 c$$$ endif
5103 c$$$ seedc=seedf
5104 c$$$
5105 c$$$ 100 format(a,i10,10x,a,d26.15)
5106 c$$$ call utprix('aseed',ish,ishini,4)
5107 c$$$ return
5108 c$$$ end
5109 c$$$
5110 c-----------------------------------------------------------------------
5111 subroutine astati
5112 c-----------------------------------------------------------------------
5113
5114 include 'epos.inc'
5115 common/geom/rmproj,rmtarg,bmax,bkmx
5116 common/ghecsquel/anquasiel,iquasiel
5117
5118 call utpri('astati',ish,ishini,1)
5119 if(ish.ge.1.and.iappl.eq.1.)then
5120 if(abs(accept+reject).gt.1.e-5)write(ifch,'(a,f9.5)')
5121 *'EMS acc.rate:',accept/(accept+reject)
5122 if(antot.ne.0.)write(ifch,*)'initial soft,hard(%)'
5123 * ,ansf/antot*100.
5124 * ,ansh/antot*100.,' of' ,antot
5125 if(antotf.ne.0.)write(ifch,*)'final soft,hard(%)'
5126 * ,ansff/antotf*100.
5127 * ,anshf/antotf*100.,' of' ,antotf
5128 if(antotre.ne.0.)write(ifch,*)
5129 * 'droplet,string(+d),reson(+d), (had)(%) '
5130 if(antotre.ne.0.)write(ifch,*)' '
5131 * ,andropl/antotre*100.
5132 * ,anstrg0/antotre*100.
5133 * ,'(',anstrg1/antotre*100.,') '
5134 * ,anreso0/antotre*100.
5135 * ,'(',anreso1/antotre*100.,') '
5136 if(antotre.ne.0.)write(ifch,*)' '
5137 * ,' (',anghadr/antotre*100.,')',' of' ,antotre
5138 if(pp4ini.gt.0.)write(ifch,*)'Energy loss',(pp4ini-pp4max)/pp4ini
5139 write(ifch,*)'ine cross section:',sigineex
5140 write(ifch,*)'diffr cross section:',sigdifex
5141 write(ifch,*)'SD cross section:',sigsdex
5142 c if(model.eq.3)write(ifch,*)'quasi-elastic cross section:'
5143 c &,anquasiel/float(ntevt)*a*10
5144 endif
5145
5146 c$$$ call testconex(3)
5147
5148 if(iprmpt.le.0)goto1000
5149
5150 write(ifch,'(77a1)')('-',i=1,77)
5151 write(ifch,'(a)')'statistics'
5152 write(ifch,'(77a1)')('-',i=1,77)
5153 write(ifch,'(a,i6)')'nr of messages:',imsg
5154 write(ifch,'(a,i8)')'maximum nptl:',nptlu
5155 write(ifch,'(77a1)')('-',i=1,77)
5156
5157 1000 continue
5158 call utprix('astati',ish,ishini,1)
5159
5160 return
5161 end
5162
5163 c-----------------------------------------------------------------------
5164 subroutine atitle
5165 c-----------------------------------------------------------------------
5166
5167 include 'epos.inc'
5168
5169 if(iLHC.eq.1)then
5170 write(ifmt,'(67a1/a1,8x,a,5x,a,23x,a1/a,22x,a,13x,a1/67a1)')
5171 *('#',l=1,68),'EPOS LHC '
5172 *,'K. WERNER, T. PIEROG','#'
5173 *,'#','Contact: tanguy.pierog@kit.edu'
5174 *,('#',l=1,68)
5175 write(ifmt,'(a,8x,a,11x,a/a,5x,a,6x,a/67a1)')
5176 * '#','WARNING: This is a special retuned version !!!','#'
5177 *,'#','Do not publish results without contacting the authors.','#'
5178 *,('#',l=1,67)
5179 else
5180 write(ifmt,'(67a1/a1,8x,a,f5.2,5x,a,7x,a1/a,22x,a,10x,a1/67a1)')
5181 *('#',l=1,68),'EPOS',iversn/100.
5182 *,'K. WERNER, T. PIEROG, S. PORTEBOEUF.','#'
5183 *,'#','Contact: werner@subatech.in2p3.fr'
5184 *,('#',l=1,68)
5185 endif
5186 if(iversn.eq.iverso)return
5187 write(ifmt,'(a,8x,a,10x,a/a,5x,a,6x,a/67a1)')
5188 * '#','WARNING: This is a non-official beta version!!!','#'
5189 *,'#','Do not publish results without contacting the authors.','#'
5190 *,('#',l=1,67)
5191
5192 return
5193 end
5194
5195 c-----------------------------------------------------------------------
5196 subroutine avehep
5197 c-----------------------------------------------------------------------
5198
5199 include 'epos.inc'
5200
5201 call utpri('avehep',ish,ishini,4)
5202
5203
5204 call utprix('avehep',ish,ishini,4)
5205 end
5206
5207
5208 c-----------------------------------------------------------------------
5209 subroutine aepos(nin)
5210 c-----------------------------------------------------------------------
5211 c Generate event
5212 c * calculates numbers of spectators:
5213 c npnevt (number of primary proj neutron spectators)
5214 c nppevt (number of primary proj proton spectators)
5215 c ntnevt (number of primary targ neutron spectators)
5216 c ntpevt (number of primary targ proton spectators)
5217 c jpnevt (number of absolute proj neutron spectators)
5218 c jppevt (number of absolute proj proton spectators)
5219 c jtnevt (number of absolute targ neutron spectators)
5220 c jtpevt (number of absolute targ proton spectators)
5221 c-----------------------------------------------------------------------
5222
5223 include 'epos.inc'
5224 include 'epos.incems'
5225 double precision eppass,etpass
5226 common/emnpass/eppass(mamx,4),etpass(mamx,4)
5227 common/photrans/phoele(4),ebeam
5228 c integer iutime(5)
5229 call utpri('aepos',ish,ishini,4)
5230
5231 c call timer(iutime)
5232 c timeini=iutime(3)+float(iutime(4))/1000.
5233 if(ish.ge.2)then
5234 call alist('start event&',0,0)
5235 write(ifch,*)'event number:',nrevt+1
5236 endif
5237
5238 c if random sign for projectile, set it here
5239 if(irdmpr.ne.0.and.laproj.eq.-1)then
5240 idproj=idprojin*(1-2*int(rangen()+0.5d0))
5241 call emsini(engy,idproj,idtarg) !recall emsini to set initial valence quark properly
5242 endif
5243
5244 c for Air target, set the target nucleus
5245 if(idtargin.eq.0.and.model.ne.6)then
5246 call getairmol(latarg,matarg)
5247 if(ish.ge.2)write(ifch,*)'Air Target, select (Z,A) :'
5248 & ,latarg,matarg
5249 endif
5250
5251 if(iappl.eq.4)then
5252 ntry=0
5253 1 ntry=ntry+1
5254 if(ntry.gt.100)stop'in aepos, to many amicro attempts. '
5255 call amicro(iret)
5256 if(iret.ne.0)goto 1
5257 if(ish.ge.2)call alist('list before int/decays&',1,nptl)
5258 nevt=1
5259 nbdky=nptl
5260 call bjinta(ier)
5261 if(ier.eq.1)stop'error in bjinta'
5262 if(ish.ge.2)call alist('list after int/decays&',1,nptl)
5263 goto 1000
5264 endif
5265
5266 if(iappl.eq.9)then
5267 call ahydro
5268 if(ish.ge.2)call alist('list before int/decays&',1,nptl)
5269 nevt=1
5270 nbdky=nptl
5271 call bjinta(ier)
5272 if(ier.eq.1)stop'error in bjinta'
5273 if(ish.ge.2)call alist('list after int/decays&',1,nptl)
5274 goto 1000
5275 endif
5276
5277 ntry=0
5278 nptly=0
5279 if(nin.le.1)bimevt=-1
5280 c save statistic at last inelastic event
5281 ntevt0=ntevt
5282 andropl0=andropl
5283 anstrg00=anstrg0
5284 anstrg10=anstrg1
5285 anreso00=anreso0
5286 anreso10=anreso1
5287 anghadr0=anghadr
5288 antotre0=antotre
5289 anintdiff0=anintdiff
5290 anintsdif0=anintsdif
5291 anintine0=anintine
5292 3 continue !set value back to last inelastic event
5293 ntevt=ntevt0
5294 andropl=andropl0
5295 anstrg0=anstrg00
5296 anstrg1=anstrg10
5297 anreso0=anreso00
5298 anreso1=anreso10
5299 anghadr=anghadr0
5300 antotre=antotre0
5301 anintdiff=anintdiff0
5302 anintsdif=anintsdif0
5303 anintine=anintine0
5304 c elastic event
5305 2 ntevt=ntevt+1
5306 iret=0
5307 ntry=ntry+1
5308 if(iappl.eq.1.or.iappl.eq.2)naevt=naevt+1
5309 5 nevt=0
5310 if(nrevt.eq.0)nptly=nptl
5311 if(iappl.ne.5)call cleanup
5312 nptl=0
5313
5314 minfra=mxptl
5315 maxfra=0
5316 if(iappl.eq.1.or.iappl.eq.2)then !---hadron---geometry---
5317 if(iret.eq.0.and.ntry.lt.10000.and.engy.ge.egymin)then !if no inel scattering -> nothing !
5318 if(model.eq.1)then
5319 call emsaaa(iret)
5320 else
5321 call emsaaaModel(model,idtargin,iret)
5322 endif
5323 if(iret.eq.-2)then !ncol=0 (force elastic)
5324 goto 5
5325 elseif(iret.lt.0)then !ncol=0
5326 goto 2
5327 elseif(iret.gt.0)then
5328 goto 3 !error
5329 endif
5330 else
5331 if(iret.eq.0)then
5332 ntevt=ntevt0+100
5333 if(ish.ge.2)
5334 & write(ifch,*)'Nothing done after ',ntry,' ntry ... continue'
5335 if(ish.ge.1)
5336 & write(ifmt,*)'Nothing done after ',ntry,' ntry ... continue'
5337 elseif(ish.ge.2)then
5338 write(ifch,*)'Elastic event.'
5339 endif
5340 iret=0
5341 nevt=1
5342 call conre !define projectile and target (elastic scattering)
5343 call conwr !when the MC is suppose to produce something but failed
5344 do i=1,nptl !activate projectile and target as final particles
5345 istptl(i)=0
5346 iorptl(i)=0
5347 enddo
5348 endif
5349 if(iappl.eq.2)then
5350 nevt=1
5351 goto 1000
5352 endif
5353
5354 elseif(iappl.eq.3.or.iappl.eq.-1) then
5355 nevt=1
5356 call bread
5357 if(ish.ge.2)call alist('list after reading&',1,nptl)
5358 goto 500
5359
5360 elseif(iappl.eq.5) then !---kinky---
5361 nptl=nptly
5362 nevt=1
5363 do i=1,nptl
5364 istptl(i)=20
5365 enddo
5366
5367 elseif(iappl.eq.6)then !---ee---
5368
5369 call timann
5370 nevt=1
5371
5372 elseif(iappl.eq.7)then !---decay---
5373
5374 call conwr
5375 nevt=1
5376
5377 elseif(iappl.eq.8)then !---lepton---
5378
5379 call psadis(iret)
5380 if(iret.gt.0)goto5
5381 nevt=1
5382
5383 endif
5384
5385 if(nevt.eq.0)stop'************ should not be ***************'
5386
5387 if(ish.ge.2)call alist('list before fragmentation&',1,nptl)
5388 nptlx=nptl+1
5389 if(iappl.ne.2.and.iappl.ne.7.and.nevt.eq.1.and.ifrade.ne.0)then
5390 iclu=0
5391 if(iLHC.eq.1.and.iorsdf.eq.3)iclu=1 !in case of fusion, don't use Z first time
5392 call gakfra(iclu,iret)
5393 if(iret.gt.0)goto 3
5394 maxfra=nptl
5395 if(ish.ge.2.and.model.eq.1)
5396 & call alist('list after fragmentation&',nptlx,nptl)
5397 if(irescl.eq.1)then
5398 call utghost(iret)
5399 if(iret.gt.0)goto 3
5400 endif
5401
5402 endif
5403
5404 500 continue
5405
5406 if(ispherio.eq.1.and.irescl.eq.1)then
5407 call utrsph(iret)
5408 if(iret.gt.0)goto 3
5409 endif
5410
5411
5412
5413 if(iappl.ne.2.and.nevt.eq.1)then
5414 nbdky=nptl
5415 call bjinta(ier)
5416 if(ier.eq.1)goto 3
5417 if(iappl.eq.1.and.irescl.eq.1)then
5418 call utresc(iret)
5419 if(iret.gt.0)goto 3
5420 endif
5421
5422
5423
5424 npnevt=0
5425 nppevt=0
5426 ntnevt=0
5427 ntpevt=0
5428 jpnevt=0
5429 jppevt=0
5430 jtnevt=0
5431 jtpevt=0
5432 if(ish.ge.2)write(ifch,'(/31a1/a/31a1)')('-',l=1,31)
5433 * ,'primary and absolute spectators',('-',l=1,31)
5434 if(ish.ge.3)write(ifch,'(/a//a/)')'projectile nucleons:'
5435 * ,' i id ior ist'
5436 do i=1,maproj
5437 if(ish.ge.3)write(ifch,'(4i6)')i,idptl(i),iorptl(i),istptl(i)
5438 io=iorptl(i)
5439 id=idptl(i)
5440 is=istptl(i)
5441 if(io.eq.0.and.id.eq.1220)npnevt=npnevt+1
5442 if(io.eq.0.and.id.eq.1120)nppevt=nppevt+1
5443 if(io.eq.0.and.is.eq.0.and.id.eq.1220)jpnevt=jpnevt+1
5444 if(io.eq.0.and.is.eq.0.and.id.eq.1120)jppevt=jppevt+1
5445 enddo
5446 if(ish.ge.3)write(ifch,'(/a//a/)')'target nucleons:'
5447 * ,' i id ior ist'
5448 do i=maproj+1,maproj+matarg
5449 if(ish.ge.3)write(ifch,'(4i6)')i,idptl(i),iorptl(i),istptl(i)
5450 io=iorptl(i)
5451 id=idptl(i)
5452 is=istptl(i)
5453 if(io.eq.0.and.id.eq.1220)ntnevt=ntnevt+1
5454 if(io.eq.0.and.id.eq.1120)ntpevt=ntpevt+1
5455 if(io.eq.0.and.is.eq.0.and.id.eq.1220)jtnevt=jtnevt+1
5456 if(io.eq.0.and.is.eq.0.and.id.eq.1120)jtpevt=jtpevt+1
5457 enddo
5458 if(ish.ge.2)then
5459 write(ifch,'(/a/)')'numbers of participants and spectators:'
5460 write(ifch,'(a,i4,a,i4)')'primary participants: projectile:'
5461 * ,npjevt,' target:',ntgevt
5462 write(ifch,'(a,i4,a,i4)')'primary spectators: projectile:'
5463 * ,npnevt+nppevt,' target:',ntnevt+ntpevt
5464 write(ifch,'(a,i4,a,i4)')
5465 * 'primary spectator neutrons: projectile:',npnevt
5466 * ,' target:',ntnevt
5467 write(ifch,'(a,i4,a,i4)')
5468 * 'primary spectator protons: projectile:',nppevt
5469 * ,' target:',ntpevt
5470 write(ifch,'(a,i4,a,i4)')'absolute spectators: projectile:'
5471 * ,jpnevt+jppevt,' target:',jtnevt+jtpevt
5472 endif
5473
5474
5475 if(model.eq.1.and.(maproj.gt.1.or.matarg.gt.1))then
5476 call emsfrag(iret)
5477 if(iret.gt.0)goto 3
5478 endif
5479
5480 if(ish.ge.1)then
5481 if(abs(iappl).eq.1.or.iappl.eq.3)then
5482 numbar=0
5483 pp4=0.
5484 do j=1,nptl
5485 if(istptl(j).eq.0)then
5486 if(idptl(j).gt. 1000.and.idptl(j).lt. 10000)numbar=numbar+1
5487 if(idptl(j).lt.-1000.and.idptl(j).gt.-10000)numbar=numbar-1
5488 if(abs(idptl(j)).eq.17)then
5489 numbar=numbar+sign(2,idptl(j))
5490 elseif(abs(idptl(j)).eq.18)then
5491 numbar=numbar+sign(3,idptl(j))
5492 elseif(abs(idptl(j)).eq.19)then
5493 numbar=numbar+sign(4,idptl(j))
5494 elseif(abs(idptl(j)).gt.1000000000)then
5495 numbar=numbar+mod(idptl(j),10000)/10
5496 endif
5497 if((((idptl(j).eq.1120.or.idptl(j).eq.1220)
5498 * .and.idproj.gt.1000).or.(iabs(idptl(j)).gt.100
5499 * .and.idproj.lt.1000)).and.pptl(4,j)
5500 * .gt.pp4.and.pptl(3,j).gt.0.)pp4=pptl(4,j)
5501 endif
5502 enddo
5503 pp4max=pp4max+pp4
5504 pp4ini=pp4ini+pptl(4,1)
5505 nvio=isign(matarg,idtarg)-numbar
5506 if(iabs(idproj).gt.1000)then
5507 nvio=nvio+isign(maproj,idproj)
5508 elseif(iabs(idproj).eq.17)then
5509 nvio=nvio+isign(2,idproj)
5510 elseif(iabs(idproj).eq.18)then
5511 nvio=nvio+isign(3,idproj)
5512 elseif(iabs(idproj).eq.19)then
5513 nvio=nvio+isign(4,idproj)
5514 endif
5515 if(ish.ge.2)write (ifch,*)'- Baryon number conservation : '
5516 & ,nvio,' -'
5517
5518 endif
5519 if(ish.ge.2.and.ifrade.ne.0)
5520 * call alist('list after int/decays&',1,nptl)
5521 endif
5522 endif
5523
5524
5525 if((iappl.eq.1.or.iappl.eq.2).and.nevt.eq.0)then
5526 if(nin.le.1)bimevt=-1
5527 goto 2
5528 endif
5529
5530 if(ifrade.ne.0.and.iappl.eq.2.and.
5531 $ idproj.eq.1120.and.idtarg.eq.1120)then
5532 numbar=0
5533 do j=1,nptl
5534 if(istptl(j).eq.0)then
5535 if(idptl(j).gt. 1000.and.idptl(j).lt. 10000)numbar=numbar+1
5536 if(idptl(j).lt.-1000.and.idptl(j).gt.-10000)numbar=numbar-1
5537 endif
5538 enddo
5539 nvio=maproj+matarg-numbar
5540 if(nvio.ne.0)then
5541 call alist('complete list&',1,nptl)
5542 write(6,'(//10x,a,i3//)')'ERROR: baryon number violation:',nvio
5543 write(6,'(10x,a//)')
5544 * 'a complete list has been printed into the check-file'
5545 stop
5546 endif
5547 endif
5548
5549
5550 ifirst=0
5551 if(nrevt+1.eq.1)ifirst=1
5552 if(jpsi.gt.0)then
5553 npjpsi=0
5554 do i=1,jpsi
5555 call jpsifo(npjpsi)
5556 call jpsian(ifirst)
5557 enddo
5558 if(ish.ge.1)call jtauan(0,0)
5559 if(nrevt+1.eq.nevent)call jpsihi
5560 endif
5561
5562 if(ixtau.eq.1)call xtauev(1)
5563
5564 1000 continue
5565 if(iabs(nin).eq.iabs(ninicon))nrevt=nrevt+1
5566
5567 nglacc=nglacc+nglevt
5568
5569
5570
5571 call utprix('aepos',ish,ishini,4)
5572 return
5573 end
5574
5575
5576 subroutine cleanup
5577
5578 include 'epos.inc'
5579 do i=1,nptl
5580 do k=1,5
5581 pptl(k,i)=0
5582 enddo
5583 iorptl(i) =0
5584 jorptl(i) =0
5585 idptl(i) =0
5586 istptl(i) =0
5587 tivptl(1,i)=0
5588 tivptl(2,i)=0
5589 ifrptl(1,i)=0
5590 ifrptl(2,i)=0
5591 ityptl(i) =0
5592 iaaptl(i) =0
5593 radptl(i) =0
5594 dezptl(i) =0
5595 itsptl(i) =0
5596 rinptl(i) =-9999
5597 do k=1,4
5598 xorptl(k,i)=0
5599 ibptl(k,i) =0
5600 enddo
5601 enddo
5602 end
5603
5604
5605 subroutine emsaaa(iret)
5606
5607
5608
5609
5610 include 'epos.inc'
5611 common/col3/ncol,kolpt
5612
5613 call utpri('emsaaa',ish,ishini,4)
5614 if(ish.ge.3)call alist('Determine Pomeron Configuration&',0,0)
5615
5616 iret=0
5617
5618 nptl=0
5619 call conaa(iret)
5620 if(iret.gt.0)goto 1001 !no interaction
5621 if(iappl.eq.2.and.ixgeometry.eq.1)call xGeometry(1)
5622 if(iappl.eq.2)goto 1000
5623 call conre
5624 call conwr
5625 call GfunParK(iret)
5626 if(iret.gt.0)goto 1000 !error
5627 if(ionudi.eq.0
5628 & .and.(maproj.ne.1.or.matarg.ne.1).and.nglevt.eq.0)goto 1001
5629 call integom1(iret)
5630 if(iret.gt.0)goto 1000 !error
5631 call emsaa(iret)
5632 if(iret.gt.0)goto 1000 !error
5633 if(ncol.eq.0)goto 1001 !no interaction
5634
5635 1000 call utprix('emsaaa',ish,ishini,4)
5636 return
5637
5638 1001 iret=-1 !no interaction
5639 goto 1000
5640
5641 end
5642
5643
5644
5645 subroutine alist(text,n1,n2)
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658 include 'epos.inc'
5659 common/cxyzt/xptl(mxptl),yptl(mxptl),zptl(mxptl),tptl(mxptl)
5660 *,optl(mxptl),uptl(mxptl),sptl(mxptl),rptl(mxptl,3)
5661
5662 character text*(*)
5663 dimension pp(5)
5664 if(n1.gt.n2)return
5665 imax=index(text,'&')
5666 if(imax.gt.1)then
5667 write(ifch,'(/1x,89a1/1x,a,a,a,90a1)')
5668 *('#',k=1,89),'############ ',text(1:imax-1),' '
5669 *,('#',k=1,74-imax)
5670 write(ifch,'(1x,89a1/)')('#',k=1,89)
5671 endif
5672 if(n1.eq.0.and.n2.eq.0)return
5673 if(imax.gt.1)then
5674 write(ifch,'(1x,a,a/1x,89a1)')
5675 *' ior jor i ifr1 ifr2 id ist ity',
5676 *' pt m E y'
5677 *,('-',k=1,89)
5678 endif
5679
5680 do j=1,5
5681 pp(j)=0.
5682 enddo
5683 nqu=0
5684 nqd=0
5685 nqs=0
5686 do i=n1,n2
5687 ptptl=pptl(1,i)**2.+pptl(2,i)**2.
5688 if(ptptl.le.0.)then
5689 ptptl=0.
5690 else
5691 ptptl=sqrt(ptptl)
5692 endif
5693 amtptl=pptl(1,i)**2.+pptl(2,i)**2.+pptl(5,i)**2.
5694 if(amtptl.le.0.)then
5695 amtptl=0.
5696 if(abs(idptl(i)).lt.10000)then
5697 call idmass(idptl(i),amtptl)
5698 endif
5699 amtptl=sqrt(amtptl*amtptl+pptl(1,i)**2.+pptl(2,i)**2.)
5700 else
5701 amtptl=sqrt(amtptl)
5702 endif
5703 rap=0.
5704 if(amtptl.gt.0..and.pptl(4,i).gt.0.)
5705 & rap=sign(1.,pptl(3,i))*alog((pptl(4,i)+abs(pptl(3,i)))/amtptl)
5706 write(ifch,'(1x,i6,i6,i6,i6,i6,i10,2i3,2x,4(e9.3,1x),$)')
5707 & iorptl(i),jorptl(i),i,ifrptl(1,i),ifrptl(2,i)
5708 & ,idptl(i),istptl(i),ityptl(i),ptptl,pptl(5,i),pptl(4,i),rap
5709 write(ifch,*)' '
5710
5711
5712
5713
5714 if(mod(istptl(i),10).eq.0.and.n1.eq.1.and.n2.eq.nptl)then
5715 do j=1,4
5716 pp(j)=pp(j)+pptl(j,i)
5717 enddo
5718 if(istptl(i).ne.40.and.istptl(i).ne.30)then
5719 call idqufl(i,idptl(i),ifl1,ifl2,ifl3)
5720 nqu=nqu+ifl1
5721 nqd=nqd+ifl2
5722 nqs=nqs+ifl3
5723 endif
5724 endif
5725 enddo
5726 end
5727
5728
5729 subroutine blist(text,n1,n2)
5730
5731 include 'epos.inc'
5732
5733 character text*(*)
5734 dimension pp(5)
5735 if(n1.gt.n2)return
5736 imax=index(text,'&')
5737 if(imax.gt.1)then
5738 write(ifch,'(/1x,89a1/1x,a,a,a,90a1)')
5739 *('#',k=1,89),'############# ',text(1:imax-1),' '
5740 *,('#',k=1,74-imax)
5741 write(ifch,'(1x,89a1/)')('#',k=1,89)
5742 endif
5743 if(n1.eq.0.and.n2.eq.0)return
5744 if(imax.gt.1)then
5745 write(ifch,'(1x,a,a,a/1x,90a1)')
5746 *' ior jor i ifr1 ifr2 id ist ity',
5747 *' pt mass energy',' rap'
5748 *,('-',k=1,90)
5749 endif
5750
5751 do j=1,5
5752 pp(j)=0.
5753 enddo
5754 nqu=0
5755 nqd=0
5756 nqs=0
5757 do i=n1,n2
5758 amtptl=pptl(1,i)**2.+pptl(2,i)**2.+pptl(5,i)**2.
5759 if(amtptl.le.0.)then
5760 amtptl=0.
5761 if(abs(idptl(i)).lt.10000)then
5762 call idmass(idptl(i),amtptl)
5763 endif
5764 amtptl=sqrt(amtptl*amtptl+pptl(1,i)**2.+pptl(2,i)**2.)
5765 else
5766 amtptl=sqrt(amtptl)
5767 endif
5768 pt=pptl(1,i)**2.+pptl(2,i)**2.
5769 if(pt.gt.0.)pt=sqrt(pt)
5770 rap=0.
5771 if(amtptl.gt.0..and.pptl(4,i).gt.0.)
5772 & rap=sign(1.,pptl(3,i))*alog((pptl(4,i)+abs(pptl(3,i)))/amtptl)
5773 write(ifch,125)iorptl(i),jorptl(i),i,ifrptl(1,i),ifrptl(2,i)
5774 & ,idptl(i),istptl(i),ityptl(i)
5775 & ,pt,pptl(5,i),pptl(4,i),rap
5776 125 format (1x,i6,i6,i6,i6,i6,i10,2i3,2x,5(e9.3,1x)
5777 * ,f9.2,4x,5(e8.2,1x))
5778 if(mod(istptl(i),10).eq.0.and.n1.eq.1.and.n2.eq.nptl)then
5779 do j=1,4
5780 pp(j)=pp(j)+pptl(j,i)
5781 enddo
5782 if(istptl(i).ne.40.and.istptl(i).ne.30)then
5783 call idqufl(i,idptl(i),ifl1,ifl2,ifl3)
5784 nqu=nqu+ifl1
5785 nqd=nqd+ifl2
5786 nqs=nqs+ifl3
5787 endif
5788 endif
5789 enddo
5790 end
5791
5792
5793 subroutine clist(text,n1,n2,ity1,ity2)
5794
5795 include 'epos.inc'
5796
5797 character text*(*)
5798 dimension pp(5)
5799 if(n1.gt.n2)return
5800 imax=index(text,'&')
5801 if(imax.gt.1)then
5802 write(ifch,'(/1x,a,a,a,90a1)')
5803 *'------------- ',text(1:imax-1),' ',('-',k=1,74-imax)
5804 endif
5805 if(n1.eq.0.and.n2.eq.0)return
5806 if(imax.gt.1)then
5807 write(ifch,'(1x,a,a/1x,90a1)')
5808 *' i id ist ity',
5809 *' pt pz p0 mass'
5810 *,('-',k=1,90)
5811 endif
5812
5813 do j=1,5
5814 pp(j)=0.
5815 enddo
5816 do i=n1,n2
5817 pt=sqrt(pptl(1,i)**2+pptl(2,i)**2)
5818 write(ifch,127)i,idptl(i),istptl(i),ityptl(i)
5819 & ,pt,pptl(3,i),pptl(4,i),pptl(5,i)
5820 127 format (1x,i6,i10,2i3,2x,4(e9.3,1x))
5821 if(ityptl(i).ge.ity1.and.ityptl(i).le.ity2)then
5822 do j=1,4
5823 pp(j)=pp(j)+pptl(j,i)
5824 enddo
5825 endif
5826 enddo
5827 write(ifch,'(90a1)')('-',k=1,90)
5828 write(ifch,127)0,0,0,0
5829 & ,sqrt(pp(1)**2+pp(2)**2),pp(3),pp(4)
5830 & ,sqrt(max(0.,pp(4)-pp(3))*max(0.,pp(4)+pp(3))-pp(1)**2-pp(2)**2)
5831 write(ifch,*)' '
5832 end
5833
5834
5835 subroutine alistf(text)
5836
5837 include 'epos.inc'
5838
5839 character text*(*)
5840 dimension pp(5),erest(5),errp(4)
5841 n1=1
5842 if(iframe.eq.21.and.(abs(iappl).eq.1.or.iappl.eq.3))
5843 *n1=2*(maproj+matarg+1)
5844 n2=nptl
5845 imax=index(text,'&')
5846 if(imax.gt.1)then
5847 write(ifch,'(/1x,124a1/1x,a,a,a,108a1)')
5848 *('#',k=1,124),'############# ',text(1:imax-1),' '
5849 *,('#',k=1,108-imax)
5850 write(ifch,'(1x,124a1/)')('#',k=1,124)
5851 endif
5852 if(imax.gt.1)then
5853 write(ifch,'(1x,a,a,a/1x,124a1)')
5854 *' ior jor i ifr1 ifr2 id ist ity',
5855 *' px py pz p0 mass',
5856 *' rap'
5857 *,('-',k=1,124)
5858 endif
5859
5860 do j=1,4
5861 pp(j)=0.
5862 errp(j)=0.
5863 enddo
5864 pp(5)=0.
5865 do i=n1,n2
5866 if(istptl(i).eq.0)then
5867 amtptl=pptl(1,i)**2.+pptl(2,i)**2.+pptl(5,i)**2.
5868 if(amtptl.le.0.)then
5869 amtptl=0.
5870 if(abs(idptl(i)).lt.10000)then
5871 call idmass(idptl(i),amtptl)
5872 endif
5873 amtptl=sqrt(amtptl*amtptl+pptl(1,i)**2.+pptl(2,i)**2.)
5874 else
5875 amtptl=sqrt(amtptl)
5876 endif
5877 rap=0.
5878 if(amtptl.gt.0..and.pptl(4,i).gt.0.)
5879 & rap=sign(1.,pptl(3,i))*alog((pptl(4,i)+abs(pptl(3,i)))/amtptl)
5880 write(ifch,125)iorptl(i),jorptl(i),i,ifrptl(1,i),ifrptl(2,i)
5881 & ,idptl(i),istptl(i),ityptl(i),(pptl(j,i),j=1,5),rap
5882
5883 do j=1,4
5884 pp(j)=pp(j)+pptl(j,i)
5885 enddo
5886 endif
5887 enddo
5888 125 format (1x,i6,i6,3x,i6,3x,i6,i6,i12,2i4,4x,5(e10.4,1x)
5889 * ,f9.2,4x,4(e8.2,1x))
5890 126 format (51x,5(e10.4,1x))
5891 128 format (51x,65('-'))
5892 pp(5)=(pp(4)-pp(3))*(pp(4)+pp(3))-pp(2)**2-pp(1)**2
5893 if(pp(5).gt.0.)then
5894 pp(5)=sqrt(pp(5))
5895 else
5896 pp(5)=0.
5897 endif
5898 write (ifch,128)
5899 write (ifch,126) (pp(i),i=1,5)
5900 erest(1)=0.
5901 erest(2)=0.
5902 if(iframe.eq.22.and.(abs(iappl).eq.1.or.iappl.eq.3))then
5903 i=maproj+matarg+1
5904 erest(3)=pptl(3,i)+matarg*pptl(3,i+1)
5905 erest(4)=pptl(4,i)+matarg*pptl(4,i+1)
5906 else
5907 erest(3)=maproj*pptl(3,1)+matarg*pptl(3,maproj+1)
5908 erest(4)=maproj*pptl(4,1)
5909 & +matarg*pptl(4,maproj+1)
5910 endif
5911 erest(5)=amproj
5912 write (ifch,129) (erest(j),j=1,5)
5913 129 format (50x,'(',5(e10.4,1x),')')
5914 do j=1,4
5915 if(abs(pp(j)).gt.0.d0)errp(j)=100.*(pp(j)-erest(j))/pp(j)
5916 enddo
5917 write (ifch,130) (errp(j),j=1,4)
5918 130 format (50x,'(',3x,4(f7.2,4x),2x,'err(%))')
5919 end
5920
5921
5922 subroutine alist2(text,n1,n2,n3,n4)
5923
5924 include 'epos.inc'
5925
5926 character text*(*)
5927 if(n1.gt.n2)return
5928 imax=index(text,'&')
5929 write(ifch,'(1x,a,a,a)')
5930 *'--------------- ',text(1:imax-1),' --------------- '
5931 do i=n1,n2
5932 write(ifch,125)iorptl(i),jorptl(i),i,ifrptl(1,i),ifrptl(2,i)
5933 &,idptl(i),istptl(i),ityptl(i),(pptl(j,i),j=1,5)
5934
5935 enddo
5936 write(ifch,'(1x,a)')'----->'
5937 do i=n3,n4
5938 write(ifch,125)iorptl(i),jorptl(i),i,ifrptl(1,i),ifrptl(2,i)
5939 &,idptl(i),istptl(i),ityptl(i),(pptl(j,i),j=1,5)
5940
5941 enddo
5942 125 format (1x,i6,i6,3x,i6,3x,i6,i6,i12,2i4,4x,5(e8.2,1x))
5943
5944 end
5945
5946
5947 subroutine alistc(text,n1,n2)
5948
5949 include 'epos.inc'
5950
5951 character text*(*)
5952 if(n1.gt.n2)return
5953 imax=index(text,'&')
5954 if(n1.ne.n2)write(ifch,'(1x,a,a,a)')
5955 *'--------------- ',text(1:imax-1),' --------------- '
5956 do i=n1,n2
5957 write(ifch,130)iorptl(i),jorptl(i),i,ifrptl(1,i),ifrptl(2,i)
5958 &,idptl(i),istptl(i),ityptl(i),(pptl(j,i),j=1,5)
5959 &,(xorptl(j,i),j=1,4),tivptl(1,i),tivptl(2,i)
5960 enddo
5961 130 format (1x,i6,i6,3x,i6,3x,i6,i6,i12,2i4,4x,5(e8.2,1x)
5962 *,4x,6(e8.2,1x))
5963 end
5964
5965
5966 subroutine sigmaint(g0,gz,sigdo)
5967
5968
5969
5970 common /ar3/ x1(7),a1(7)
5971 include 'epos.inc'
5972 include 'epos.incpar'
5973 include 'epos.incsem'
5974 include 'epos.incems'
5975 double precision PhiExact,vvv11,vvv12,vvv21,om1intbi!,PomNbri
5976 *,vvv22,ww01,ww02,ww11,ww12,ww21,ww22,gz(0:3)
5977 *,vvv11e,vvv12e,vvv21e,vvv22e,PhiExpo
5978
5979 kollini=koll
5980 koll=1
5981
5982 rs=r2had(iclpro)+r2had(icltar)+max(slopom,slopoms)*log(engy**2)
5983 & +gwidth*(r2had(iclpro)+r2had(icltar))
5984 & +bmxdif(iclpro,icltar)/4./0.0389
5985 rpom=4.*.0389*rs
5986 e1=exp(-1.)
5987
5988
5989 gz(0)=0.d0
5990 gz(1)=0.d0
5991 gz(2)=0.d0
5992 gz(3)=0.d0
5993
5994 e2=engy**2
5995
5996 sigdo=0.
5997 do i1=1,7
5998 do m=1,2
5999
6000 z=.5+x1(i1)*(m-1.5)
6001 zv1=exp(-z)
6002 zv2=(e1*z)
6003 b1=sqrt(-rpom*log(zv1))
6004 b2=sqrt(-rpom*log(zv2))
6005 zz=0.!znurho
6006
6007 if(isetcs.eq.0)then
6008 vvv11=max(0.d0,PhiExact(zz,zz,.5,1.d0,1.d0,e2,b1))
6009 vvv12=max(0.d0,PhiExact(zz,zz,.5,1.d0,1.d0,e2,b2))
6010 vvv21=max(0.d0,PhiExact(zz,zz,1.,1.d0,1.d0,e2,b1))
6011 vvv22=max(0.d0,PhiExact(zz,zz,1.,1.d0,1.d0,e2,b2))
6012 else
6013 vvv11=max(0.d0,PhiExpo(zz,zz,.5,1.d0,1.d0,e2,b1))
6014 vvv12=max(0.d0,PhiExpo(zz,zz,.5,1.d0,1.d0,e2,b2))
6015 vvv21=max(0.d0,PhiExpo(zz,zz,1.,1.d0,1.d0,e2,b1))
6016 vvv22=max(0.d0,PhiExpo(zz,zz,1.,1.d0,1.d0,e2,b2))
6017
6018
6019 if(isetcs.eq.1.and.ionudi.eq.1)then !to test simulations
6020 vvv11e=max(0.d0,PhiExact(zz,zz,.5,1.d0,1.d0,e2,b1))
6021 vvv12e=max(0.d0,PhiExact(zz,zz,.5,1.d0,1.d0,e2,b2))
6022 vvv21e=max(0.d0,PhiExact(zz,zz,1.,1.d0,1.d0,e2,b1))
6023 vvv22e=max(0.d0,PhiExact(zz,zz,1.,1.d0,1.d0,e2,b2))
6024 vvv11=0.5d0*(vvv11+vvv11e) !to be as close as possible
6025 vvv12=0.5d0*(vvv12+vvv12e) !than the value with
6026 vvv21=0.5d0*(vvv21+vvv21e) !isetcs > 0
6027 vvv22=0.5d0*(vvv22+vvv22e)
6028 endif
6029 endif
6030 ww11=1.d0-vvv11
6031 ww12=1.d0-vvv12
6032 ww21=1.d0-vvv21
6033 ww22=1.d0-vvv22
6034 ww01=vvv21-2d0*vvv11+1d0
6035 ww02=vvv22-2d0*vvv12+1d0
6036
6037 gz(0)=gz(0)+a1(i1)*(ww01+ww02/z)
6038 gz(1)=gz(1)+a1(i1)*(ww11+ww12/z)
6039 gz(2)=gz(2)+a1(i1)*(ww21+ww22/z)
6040 gz(3)=gz(3)+a1(i1)*(ww11*z+ww12/z*(1.-log(z)))
6041
6042 phi1=vvv21
6043 phi2=vvv22
6044 phi1x=sngl(min(50d0,exp(om1intbi(b1,2)/dble(r2hads(iclpro)
6045 & +r2hads(icltar)))))
6046 phi2x=sngl(min(50d0,exp(om1intbi(b2,2)/dble(r2hads(iclpro)
6047 & +r2hads(icltar)))))
6048 sigdo=sigdo+a1(i1)*(phi1*(phi1x-1.)+phi2*(phi2x-1.)/z)
6049
6050 enddo
6051 enddo
6052 g0=pi*rpom*10./2. !common factor (pi*rpom because of b->z, 10 to have mbarn and /2. because z is from -1 to 1 but we need 0 to 1.
6053
6054 koll=kollini
6055
6056 return
6057 end
6058
6059 subroutine xsigma
6060
6061
6062
6063
6064 include 'epos.inc'
6065 include 'epos.incsem'
6066 double precision gz(0:3),gzp(0:3),GZ0(2)
6067
6068 COMMON /Q_AREA1/ IA(2),ICZ,ICP
6069 COMMON /Q_AREA6/ PIQGS,BM,AM
6070 COMMON /Q_AREA15/ FP(5),RQ(5),CD(5)
6071 COMMON /Q_AREA7/ RP1
6072 COMMON /Q_AREA16/ CC(5)
6073 double precision RP1,FP,RQ,CD,PIQGS,BM,AM,CC,GDP,GDT,GDD
6074
6075
6076 double precision SIGT
6077 COMMON/PYINT7/SIGT(0:6,0:6,0:5)
6078
6079
6080 COMMON/HIPARNT/HIPR1(100), IHPR2(50), HINT1(100), IHNT2(50)
6081
6082
6083 sigcut=0.
6084 sigtot=0.
6085 sigela=0.
6086 sigine=0.
6087 sigtotold=0.
6088 sigtotf=0.
6089 sigelaold=0.
6090 sigelaf=0.
6091 sigineold=0.
6092 sigineaa=0.
6093 sigtotaa=0.
6094 sigelaaa=0.
6095 sigcutaa=0.
6096 sigdif=0.
6097 sloela=0.
6098 sigsd=0.
6099 sigdd=0.
6100
6101 sigineex=0. !calculated in ems if isigma>0
6102 sigdifex=0.
6103 sigsdex=0.
6104
6105
6106 call utpri('xsigma',ish,ishini,4)
6107
6108 if(model.eq.1)then !epos
6109
6110 if(icltar.ne.2)stop'xsigma: only icltar=2 allowed.'
6111
6112 call sigmaint(g0,gz,sigdifold)
6113
6114 sigelaold=g0*gz(0) !elastic cross section
6115 rs=g0*0.4091 !=g0/pi/10.*2./4./.0389
6116 if(gz(1).gt.0d0)sloela=2.*rs*gz(3)/gz(1)
6117
6118 sigineold=g0*gz(2) !inelastic pomerons cross-section
6119 sigtotold=2.*g0*gz(1) !tot cross-section
6120 sigdifold=sigdifold * g0 !xs in mb
6121 sigcut=sigineold-sigdifold !cut cross section
6122 x=engy
6123
6124 sigtotf=14.5*x**0.21+20.*x**(-0.2)+19.*(x-1.)**(-1)
6125 sigelaf=35.*(x-1)**(-2.8)+17.*x**(-0.47)+0.31*log(x)**2
6126
6127
6128 if(iclpro.eq.1)then !pi+p
6129 sigtotf=10.*(x-1)**(-3)+16.*x**0.13+40.*x**(-1.2)
6130 sigelaf=20.*(x-1)**(-3)+6.*x**(-0.4)+0.15*log(x)**2.
6131 elseif(iclpro.eq.3)then !K+p
6132 sigtotf=13.*x**0.15+35.*x**(-1.5)
6133 sigelaf=15.*(x-1)**(-3)+5.*x**(-0.4)+0.1*log(x)**2
6134 elseif(iclpro.eq.4)then !D+p
6135 sigtotf=0.!12.5*x**0.15+35.*x**(-1.5)
6136 sigelaf=0.!15.*(x-1)**(-3)+3.*x**(-0.4)+0.2*alog(x)**2
6137 endif
6138 if(engy.lt.20.)then
6139 sigcoul=max(0.,sigtotf-sigtotold)
6140 else
6141 sigcoul=0.
6142 endif
6143
6144
6145 sigdif=sigdifold
6146 sigdelaf=max(0.,(sigelaf+sigineold-sigtotf))
6147
6148 edlim=0.015
6149 if(rexdifi(iclpro).lt.0..or.rexdifi(icltar).lt.0.)then
6150
6151 sigdela=min(sigdelaf,sigdif)
6152
6153
6154 if(rexdifi(icltar).lt.0.)then
6155
6156 if(engy.lt.min(30.,-log(-rexdifi(icltar))/edlim))then
6157
6158 if(iclpro+icltar.ne.4)then
6159 iclprosave=iclpro
6160 iclpro=2
6161 call sigmaint(g0p,gzp,sigdifp)
6162
6163 sigdifp=sigdifp * g0p
6164
6165
6166 iclpro=iclprosave
6167 else
6168 sigdifp=sigdif
6169
6170
6171 endif
6172 if(sigdifp.gt.0.)then
6173
6174
6175
6176
6177 rexdif(icltar)=exp(-edlim*engy)
6178 rexdif(icltar)=max(rexdif(icltar),abs(rexdifi(icltar)))
6179 else
6180 rexdif(icltar)=1.
6181 endif
6182 else
6183
6184
6185 rexdif(icltar)=abs(rexdifi(icltar))
6186 endif
6187 else
6188 rexdif(icltar)=rexdifi(icltar)
6189 endif
6190
6191 if(iclpro.ne.2)then !pi or K rexdif knowing p rexdif
6192 if(rexdifi(iclpro).lt.0.)then
6193 if(engy.lt.min(30.,-log(-rexdifi(iclpro))/edlim)
6194 & .and.sigdif.gt.0.)then !use fit of sigela to get rexdif
6195
6196
6197
6198
6199
6200
6201
6202
6203 rexdif(iclpro)=exp(-edlim*engy)
6204 rexdif(iclpro)=max(rexdif(iclpro),abs(rexdifi(iclpro)))
6205 elseif(sigdif.le.0.)then
6206 rexdif(iclpro)=1.
6207 else
6208
6209
6210 rexdif(iclpro)=abs(rexdifi(iclpro))
6211 endif
6212 else
6213 rexdif(iclpro)=abs(rexdifi(iclpro))
6214 endif
6215 endif
6216 sigdela=(1.-rexdif(iclpro))
6217 & *(1.-rexdif(icltar)) *sigdif
6218
6219 else
6220 rexdif(iclpro)=rexdifi(iclpro)
6221 rexdif(icltar)=rexdifi(icltar)
6222 sigdela=(1.-rexdif(iclpro))
6223 & *(1.-rexdif(icltar)) *sigdif
6224 endif
6225
6226
6227
6228 if(rexndf.gt.0.)then
6229 rexndi(iclpro)=rexndf*rexdif(iclpro)
6230 else
6231 rexndi(iclpro)=rexndii(iclpro)
6232 endif
6233
6234 if(rexndf.gt.0.)then
6235 rexndi(icltar)=rexndf*rexdif(icltar)
6236 else
6237 rexndi(icltar)=rexndii(icltar)
6238 endif
6239 if(ish.ge.2)write(ifch,*)'Xsigma : rexdif/ndi=',rexdif(iclpro)
6240 & ,rexdif(icltar)
6241 & ,rexndi(iclpro)
6242 & ,rexndi(icltar)
6243
6244 sigsd=( (1.-rexdif(icltar))*rexdif(iclpro)
6245 & +(1.-rexdif(iclpro))*rexdif(icltar) )*sigdif
6246 sigdd=rexdif(iclpro)*rexdif(icltar)*sigdif
6247
6248 sigela=sigelaold+sigcoul
6249 sigine=sigineold
6250 if(ionudi.ne.1.and.iLHC.eq.0)then
6251 sigela=sigela+sigdela
6252 sigine=sigine-sigdela
6253 endif
6254 sigtot=sigine+sigela
6255 sigineaa=eposcrse(ekin,maproj,matarg,idtarg)
6256
6257
6258
6259 elseif(model.eq.2)then
6260
6261 g0=real(PIQGS*RP1/CD(ICZ)*AM**2*10.D0)
6262 CALL m2XXFZ(0.D0,GZ0)
6263 gz(1)=GZ0(1)
6264 gz(2)=GZ0(2)
6265 gz(3)=0d0
6266 sigcut=g0*gz(2)/2. !cut pomerons cross-section
6267 sigtot=g0*gz(1) !tot cross-section
6268 gz(0)=sigtot-sigcut
6269 sigela=gz(0)*CC(ICZ)*CC(2) !elastic cross section
6270
6271 GDP=(1.D0-CC(ICZ))*CC(2)*gz(0)
6272
6273 GDT=(1.D0-CC(2))*CC(ICZ)*gz(0)
6274
6275 GDD=(1.D0-CC(ICZ))*(1.D0-CC(2))*gz(0)
6276 sigsd=GDT+GDP
6277 sigdd=GDD
6278 sigdif=sigsd+sigdd
6279 sigine=sigcut+sigdif
6280 rs=g0*0.4091 !=g0/pi/10.*2./4./.0389
6281 if(gz(1).gt.0.)sloela=2.*rs*gz(3)/gz(1)
6282 sigdifold=sigtot-sigcut-sigela !diffractive cross section
6283 sigineaa=qgsincs
6284
6285 elseif(model.eq.3)then
6286
6287 call m3SIGMA(ekin,idproj,1120,1,1,sigi,sige)
6288 sigine=sigi
6289 sigela=sige
6290 sigcut=sigine
6291 sigtot=sigine+sigela
6292 sigdif=sigtot-sigcut-sigela !diffractive cross section
6293 sigineaa=gheincs
6294
6295 elseif(model.eq.4)then !PYTHIA
6296
6297 sigsd=sngl(SIGT(0,0,2)+SIGT(0,0,3))
6298 sigela=sngl(SIGT(0,0,1))
6299 sigcut=sngl(SIGT(0,0,5))
6300 sigtot=sngl(SIGT(0,0,0))
6301 sigine=sigtot-sigela
6302 sigdif=sigtot-sigcut-sigela !diffractive cross section
6303 sigineaa=pytincs
6304
6305 elseif(model.eq.5)then !HIJING
6306
6307 sigsd=HIPR1(33)*HINT1(12)
6308 sigdif=0.
6309 sigcut=0.
6310 sigtot=HINT1(13)
6311 sigine=HINT1(12)
6312 sigela=sigtot-sigine
6313 sigineaa=hijincs
6314
6315 elseif(model.eq.6)then !for Sibyll
6316
6317 call m6SIGMA(iclpro,engy,stot,sela,sine,sdifr,slela,Rho)
6318 sigtot=stot
6319 sigela=sela
6320 sigine=sine
6321 sigdif=sdifr
6322 sloela=slela
6323 sigcut=sigtot-sigdif-sigela ! cut cross section
6324 sigsd=sigdif/2.
6325 sigineaa=sibincs
6326
6327 elseif(model.eq.7.or.model.eq.11)then !for QGSJET-II
6328
6329 call m7SIGMA(stot,scut,sine,slela)
6330 sigtot=stot
6331 sigcut=scut
6332 sigine=sine
6333 sloela=slela
6334 sigela=sigtot-sigine ! elastic cross section
6335 sigdif=sigine-sigcut
6336 sigsd=sigdif
6337 sigineaa=qgsIIincs
6338
6339 elseif(model.eq.8)then !for PHOJET
6340
6341 call m8SIGMA(stot,scut,sine,sela,slela,ssd)
6342 sigtot=stot
6343 sigcut=scut
6344 sigine=sine
6345 sloela=slela
6346 sigela=sela
6347 sigdif=sigine-sigcut
6348 sigsd=ssd
6349 sigineaa=phoincs
6350
6351 elseif(model.eq.9)then !for Fluka
6352
6353 call m9SIGMA(stot,sine,sela)
6354 sigtot=stot
6355 sigine=sine
6356 sigcut=sigine
6357 sigela=sela
6358 sigineaa=fluincs
6359
6360 elseif(model.eq.10)then !for Urqmd
6361
6362 sigtot=urqincs
6363 sigineaa=urqincs
6364
6365 endif
6366
6367 if(isigma.ge.1)then !===============!
6368
6369 if(ish.ge.1.and.noebin.ge.0)
6370 *write (ifmt,225)engy,ekin,sigtot,sigtotf,sigtotold
6371 *,sigine,sigtotf-sigelaf,sigineold
6372 *,sigela,sigelaf,sigelaold,sigcut,sloela,sigdif,sigsd
6373 *,sigineaa
6374 if(ish.ge.1.and.ifch.ne.ifmt)
6375 *write (ifch,225)engy,ekin,sigtot,sigtotf,sigtotold
6376 *,sigine,sigtotf-sigelaf,sigineold
6377 *,sigela,sigelaf,sigelaold,sigcut,sloela,sigdif,sigsd
6378 *,sigineaa
6379
6380
6381 if((isigma.eq.2.and.noebin.ge.0)
6382 & .or..not.(maproj.eq.1.and.matarg.eq.1))then
6383
6384 sigtotaa=0.
6385 sigelaaa=0.
6386 if(model.eq.1)then
6387 if(isigma.ne.2)then
6388
6389 sigineaa=eposinecrse(ekin,maproj,matarg,idtarg)
6390 sigelaaa=eposelacrse(ekin,maproj,matarg,idtarg)
6391 sigtotaa=sigelaaa+sigineaa
6392 sigcutaa=eposcutcrse(ekin,maproj,matarg,idtarg)
6393 if(ionudi.gt.1)then
6394
6395 difpart=max(0.,sigineaa-sigcutaa)
6396
6397 sigqela=(1.-rexdif(iclpro))
6398 & **(1.+rexres(iclpro)*0.3*log(float(matarg)))
6399 sigqela=sigqela**(1.+float(maproj)**0.3)
6400 sdpart=1.d0-sigqela
6401
6402 if(iLHC.eq.1)then
6403 sigqelap=sigqela
6404 sigqela=sigqela*((1.-rexdif(icltar))
6405 & **(1.+rexres(icltar)*0.3*log(float(maproj))))
6406 & **(1.+float(matarg)**0.3)
6407 if(ionudi.eq.2)sigqela=sigqelap-sigqela
6408 sdpart=1.d0-sigqela
6409 sigqela=0.
6410 elseif(ionudi.eq.3)then
6411 sigqela=sigqela*((1.-rexdif(icltar))
6412 & **(1.+rexres(icltar)*0.3*log(float(maproj))))
6413 & **(1.+float(matarg)**0.3)
6414 sdpart=1.d0-sigqela
6415 endif
6416
6417 sigqela=sigqela*difpart
6418 sigineaa=sigineaa-sigqela
6419 sigelaaa=sigelaaa+sigqela
6420
6421 sigcutaa=sigcutaa+0.95*difpart*sdpart
6422 elseif(ionudi.eq.0)then
6423 write(ifmt,*)
6424 & 'Cross-section can not be calculated with ionudi=0'
6425 endif
6426 else
6427 call crseaaEpos(sigtotaa,sigineaa,sigcutaa,sigelaaa)
6428 endif
6429 elseif(isigma.eq.2)then
6430 call crseaaModel(sigtotaa,sigineaa,sigcutaa,sigelaaa)
6431 endif
6432 if(ish.ge.1.and.noebin.ge.0)
6433 & write (ifmt,226)sigtotaa,sigineaa,sigcutaa,sigelaaa
6434 if(ish.ge.1.and.ifch.ne.ifmt)
6435 & write (ifch,226)sigtotaa,sigineaa,sigcutaa,sigelaaa
6436
6437 endif !================!
6438
6439
6440 endif
6441
6442
6443
6444 225 format(' hadron-proton cross sections for ',f10.2,' GeV',
6445 *' (ekin:',g13.5,' GeV)'/
6446 *4x,'total cross section: ',f8.2,3x,f8.2,3x,f8.2/
6447 *4x,'inelastic cross section: ',f8.2,3x,f8.2,3x,f8.2/
6448 *4x,'elastic cross section: ',f8.2,3x,f8.2,3x,f8.2/
6449 *4x,'cut cross section: ',f8.2/
6450 *4x,'elastic slope parameter: ',f8.2/
6451 *4x,'diffr. cross section: ',f8.2,14x,f8.2/
6452 *4x,'inelastic (tab) cross section: ',f8.2)
6453 226 format(' hadron/nucleus-hadron/nucleus cross sections'/
6454 *4x,'total pA/AA cross section: ',f8.2/
6455 *4x,'inelastic pA/AA cross section: ',f8.2/
6456 *4x,'cut pA/AA cross section: ',f8.2/
6457 *4x,'elastic pA/AA cross section: ',f8.2)
6458
6459 call utprix('xsigma',ish,ishini,4)
6460
6461 return
6462 end
6463