Back to home page

Project CMSSW displayed by LXR

 
 

    


File indexing completed on 2021-02-14 13:07:28

0001 
0002 c-----------------------------------------------------------------------
0003       subroutine aaset(iop)
0004 c-----------------------------------------------------------------------
0005 c     sets parameters and options, initializes counters ...
0006 c-----------------------------------------------------------------------
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 c  version
0041 
0042       iversn=int(1.99*100) !version number
0043       iverso=int(1.99*100) !last official version
0044 
0045 c  application
0046 
0047       iappl=1          !choice for application (0,1,2,3,4,5,6,7,8,9,10)
0048 
0049 c  model
0050 
0051       model=1
0052       iquasiel=1       !allow (1) or not (0) quasi-elastic event in model 3
0053 
0054 c  file names and units
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 c  initial seed
0093 
0094 c following number should be less than kseq in RMMARD (=2 in EPOS)
0095       iseqini=2   !sequence number at start program 
0096 c seed for random number generator: at start program
0097       seedi=0d0   !.ne.0.
0098       iseqsim=1   !.ne.iseqini : sequence number at start program 
0099 c seed for random number generator: for first event
0100       seedj=0d0   !.ne.0.
0101 c place to start for random number generator: for first event
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 c  some basic things
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 c  printout options
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 c  fragmentation and decay parameters
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 c energy dependence comes from fit of e+e->had mult in epos-fra
0152 c this parameter is used to fix the increase of baryon and strangeness for Tevatron
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 c if -1<pb<0, take pb for soft and e+e- parameterization for hard strings
0171       pbreakg=0. !minimum pbreak at high energy in e+e- parameterization
0172       zetacut=0.  !g->ggq2 cut for special hadronization
0173 
0174 c  fragmentation and decay options
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 c  lepton-nucleon and e+e- options
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 c  hadron-hadron options +++
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 c  hadron-hadron options
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 c  hadron-hadron parameters +++
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 c  hadron-hadron parameters
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 c wgtqqq (<1) define the probability that the diquark is a taken 
0314 c (or introduced in  a meson) directly from the remnant 
0315 c it is for stopping not for baryon prod (put baryon in the center but do 
0316 c not change very large x of mesons). Value fixed with forward baryon 
0317 c in pion interactions. Active only with iremn>1
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 c within 1-wgtqqq not to take a diquark, wgtdiq (<1) is 
0323 c the absolut probability to create a diquark as string end
0324       wgtdiq=0.15      !weight for seadiq - antidiq as soft string end 
0325 c in the 1-wgtqqq-wgtdiq probabilty not to have a q-aq string ends,
0326 c wgtval is the probability to take the valence quark in soft interactions
0327 c wgtsea is the probability to take a q-aq pair from the sea, 
0328 c if no valence quarks are available, then we use sea quarks
0329 c these values can be arbitrary choosen since wgtval/wgtsea is used
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 c soft/hard selection like without screening to get shape of pt 
0341 c distribution in pp right and energy density in auau
0342 c gfactor < 0 means that the hard contribution is increased % soft 
0343 c when Z increase : doesn't seem to be supported by HERA-B data
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 c following parameters recalculated in xsigma ...
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 c ... up to here.
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 c screening splitting +++
0410 
0411 c Note : cross section/saturation value, change inelasticity and not only cross section
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 c nuclear part of Z
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 c Z dependent parameters
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 c Reggeon parameters  (not used)
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 c  masses
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 c      qcmass=1.6               !c-quark mass  (in idmass = 1.2 )
0456 c      amhdibar=2.200           !h-dibaryon mass       !not used any more
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 c  nucleus-nucleus
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 c      ncolmx=100000 !maximum number of collisions
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 c rescattering parameters +++
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 c rescattering parameters
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 c coupling with urqmd
0547 
0548       iurqmd=0    ! call eposurqmd (1) or not
0549 
0550 c initial conditions for hydro
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 c  cluster decay
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 c  droplet decay initializations
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 c  droplet specification
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 c  metropolis and grand canonical
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 c  strangelets
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 c tests
0670 
0671       iotst1=0     !test
0672       iotst2=0     !test
0673       iotst3=0     !test
0674       iotst4=0     !test
0675 
0676 c  jpsi
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 c  analysis: intermittency, space-time, droplets, formation time
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 c  storing
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 c  other
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 c  constants
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 c air
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 c  zero initializations
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 c  analysis
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 c-----------------------------------------------------------------------
0920       subroutine LHCparameters
0921 c-----------------------------------------------------------------------
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 c cross section based parameters
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 c slope and diffraction
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 c remnant excitation
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 c string fragmentation
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 c energy dependence comes from fit of e+e->had mult in epos-fra
1004 c this parameter is used to fix the increase of baryon and strangeness for Tevatron
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 c radial flow (new)
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 c radial flow (old)
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 c long flow
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 c-----------------------------------------------------------------------
1042       subroutine estore
1043 c-----------------------------------------------------------------------
1044 c     writes the results of a simulation into the file with unit ifdt
1045 c     contains a description of the stored variables.
1046 c     modifiable by the user
1047 c-----------------------------------------------------------------------
1048       include 'epos.inc'
1049 
1050 c  count the number of particles to be stored (--> nptevt)
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 c-----------------------------------------------------------------------
1078       subroutine hepmcstore
1079 c-----------------------------------------------------------------------
1080 c     writes the results of a simulation into the file with unit ifdt
1081 c     contains a description of the stored variables.
1082 c-----------------------------------------------------------------------
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 c  count the number of particles to be stored
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 c  store event variables in HEP common :
1104 
1105 
1106 c information available :
1107 c     nrevt.......... event number
1108       nevhep=nrevt
1109 c     nptevt ........ number of (stored!) particles per event
1110 c     bimevt ........ absolute value of impact parameter
1111 c     phievt ........ angle of impact parameter
1112 c     kolevt ........ number of collisions
1113 c     pmxevt ........ reference momentum
1114 c     egyevt ........ pp cm energy (hadron) or string energy (lepton)
1115 c     npjevt ........ number of primary projectile participants
1116 c     ntgevt ........ number of primary target participants
1117 c     npnevt ........ number of primary projectile neutron spectators
1118 c     nppevt ........ number of primary projectile proton spectators
1119 c     ntnevt ........ number of primary target neutron spectators
1120 c     ntpevt ........ number of primary target proton spectators
1121 c     jpnevt ........ number of absolute projectile neutron spectators
1122 c     jppevt ........ number of absolute projectile proton spectators
1123 c     jtnevt ........ number of absolute target neutron spectators
1124 c     jtpevt ........ number of absolute target proton spectators
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 c  store particle variables:
1141 
1142 c     i ............. particle number
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 c     create special father/mother to have the complete chain from beam to final particle
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 c              print *,'rcore',i,iorptl(io)
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 c              print *,'remn',i,iorptl(io)
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 c              print *,'string',i,iorptl(io)
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 c              print *,'core',i,iorptl(io)
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 c              jm2io=jorptl(io)
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 c            print *,'clean',i,iorptl(io),pptl(3,i),jm1io
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 c       idptl(i) ...... particle id
1327         idhep2(nhep2)=id
1328 c       pptl(1,i) ..... x-component of particle momentum (GeV/c)
1329         phep2(1,nhep2)=dble(pptl(1,ii))
1330 c       pptl(2,i) ..... y-component of particle momentum (GeV/c)
1331         phep2(2,nhep2)=dble(pptl(2,ii))
1332 c       pptl(3,i) ..... z-component of particle momentum (GeV/c)
1333         phep2(3,nhep2)=dble(pptl(3,ii))
1334 c       pptl(4,i) ..... particle energy  (GeV)
1335         phep2(4,nhep2)=dble(pptl(4,ii))
1336 c       pptl(5,i) ..... particle mass    (GeV/c2)
1337         phep2(5,nhep2)=dble(pptl(5,ii))
1338 c       istptl(i) ..... generation flag: last gen. (0) or not (1)
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 c       ityptl(i) ..... particle type (string, remnant ...)
1342 c       xorptl(1,i) ... x-component of formation point (fm)
1343         vhep2(1,nhep2)=xorptl(1,ix)*1e-12 !conversion to mm
1344 c       xorptl(2,i) ... y-component of formation point (fm)
1345         vhep2(2,nhep2)=xorptl(2,ix)*1e-12 !conversion to mm
1346 c       xorptl(3,i) ... z-component of formation point (fm)
1347         vhep2(3,nhep2)=xorptl(3,ix)*1e-12 !conversion to mm
1348 c     xorptl(4,i) ... formation time (fm/c)
1349         vhep2(4,nhep2)=xorptl(4,ix)*1E-12 !conversion to mm/c
1350 c       tivptl(1,i) ... formation time (always in the pp-cms!)
1351 c       tivptl(2,i) ... destruction time (always in the pp-cms!)
1352 c       ifrptl(1,i) ..... particle number of first daughter (no daughter=0)
1353         jdahep2(1,nhep2)=jd1      !need a second loop to calculated proper indice
1354 c       ifrptl(2,i) ..... particle number of last daughter (no daughter=0)
1355         jdahep2(2,nhep2)=jd2      !need a second loop to calculated proper indice
1356 c       iorptl(i) ..... particle number of father (if .le. 0 : no father)
1357         jmohep2(1,nhep2)=jm1
1358 c       jorptl(i) ..... particle number of mother (if .le. 0 : no mother)
1359         jmohep2(2,nhep2)=jm2
1360 
1361       enddo
1362 
1363  100  continue
1364 
1365       endif
1366       enddo
1367 
1368 c copy first list in final list to define daughters of beam particles 
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 c start with beam particles (except spectators producing fragments)
1377 
1378       do j=1,maproj+matarg
1379 
1380         if(istmaxhep.eq.0)then
1381 
1382 c when no daughter/mother informations, simply copy beam particles
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 c copy all daughters after the mother
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 c copy all other particles (secondary particles and spectators)
1510 
1511       do k=maproj+matarg+1,nhep2
1512 
1513           if(isthep2(k).gt.0)then
1514 
1515 c look for mother of fragments
1516             nhep0=nhep+1
1517             nhepi0=nhepio+1
1518             if(jmohep2(1,k).gt.0.and.jmohep2(1,k).le.maproj+matarg)then
1519 c copy all mothers before the daughter
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 c        print *,'         ',k,idhep(k),isthep(k),'from',ihep2epo(k)
1616         enddo
1617         print *,'          Particle list not consistent, skip event !'
1618         print *,'         ',nrem1,'->',nrem2
1619         goto 10000
1620       endif
1621 
1622 c update daughter list with correct index
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 c         ifrptl(1,i) ..... particle number of first daughter (no daughter=0)
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 c         ifrptl(2,i) ..... particle number of last daughter (no daughter=0)
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 c      write(ifdt,130)jmohep(1,j),jmohep(2,j),j,jdahep(1,j),jdahep(2,j)
1655 c     &,idhep(j),isthep(j),(phep(k,j),k=1,5),(vhep(k,j),k=1,4)
1656 c 130  format (1x,i6,i6,3x,i6,3x,i6,i6,i12,i4,8x,5(e8.2,1x)
1657 c     *,4x,4(e8.2,1x))
1658         
1659       enddo
1660 
1661 
1662  9999 return
1663 10000 nhep=0
1664       goto 9999
1665       end
1666 
1667 c-----------------------------------------------------------------------
1668       subroutine lhestore(n)
1669 c-----------------------------------------------------------------------
1670 c     writes the results of a simulation into the file with unit ifdt
1671 c     contains a description of the stored variables.
1672 c     use Les Houches Event File as defined in hep-ph/0109068 for the
1673 c     common block and hep-ph/0609017 for the XML output.
1674 c     some code taken from example from Torbjrn Sjstrand
1675 c     in http://www.thep.lu.se/~torbjorn/lhef
1676 c-----------------------------------------------------------------------
1677       include 'epos.inc'
1678  
1679 C...User process event common block.
1680       INTEGER MAXNUP
1681       PARAMETER (MAXNUP=50000)  !extend array for file production
1682 c      PARAMETER (MAXNUP=500)
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 c  count the number of particles to be stored (--> nptevt)
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 C...set event info and get number of particles.
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 C...Copy event lines, omitting trailing blanks. 
1714 C...Embed in <event> ... </event> block.
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 c     i ............. particle number
1724 c     idptl(i) ...... particle id
1725           idpdg=idtrafo('nxs','pdg',idptl(i))
1726           if(idpdg.eq.99)idpdg=0   !unknown particle
1727           iepo2hep(i)=nhep
1728 c  store particle variables:
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 c     jorptl(i) ..... particle number of mother (if .le. 0 : no mother)
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 c optional informations
1767       write(ifdt,*)'#geometry',bimevt,phievt
1768 
1769       write(ifdt,'(A)') '</event>' 
1770 
1771       if(n.eq.nevent)then
1772 C...Successfully reached end of event loop: write closing tag
1773         write(ifdt,'(A)') '</LesHouchesEvents>' 
1774         write(ifdt,'(A)') ' ' 
1775       endif
1776 
1777  1000 continue
1778 
1779       return
1780       end
1781 
1782 
1783 c-----------------------------------------------------------------------
1784       subroutine ustore
1785 c-----------------------------------------------------------------------
1786 c     writes the results of a simulation into the common hepevt
1787 c     contains a description of the stored variables.
1788 c     modifiable by the user
1789 c-----------------------------------------------------------------------
1790       include 'epos.inc'
1791       integer iepo2hep(mxptl)
1792 
1793 
1794 c  count the number of particles to be stored (--> nptevt)
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 c  store event variables in HEP common :
1803 
1804 
1805 c information available :
1806 c     nrevt.......... event number
1807       nevhep=nrevt
1808 c     nptevt ........ number of (stored!) particles per event
1809 c     bimevt ........ absolute value of impact parameter
1810 c     phievt ........ angle of impact parameter
1811 c     kolevt ........ number of collisions
1812 c     pmxevt ........ reference momentum
1813 c     egyevt ........ pp cm energy (hadron) or string energy (lepton)
1814 c     npjevt ........ number of primary projectile participants
1815 c     ntgevt ........ number of primary target participants
1816 c     npnevt ........ number of primary projectile neutron spectators
1817 c     nppevt ........ number of primary projectile proton spectators
1818 c     ntnevt ........ number of primary target neutron spectators
1819 c     ntpevt ........ number of primary target proton spectators
1820 c     jpnevt ........ number of absolute projectile neutron spectators
1821 c     jppevt ........ number of absolute projectile proton spectators
1822 c     jtnevt ........ number of absolute target neutron spectators
1823 c     jtpevt ........ number of absolute target proton spectators
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 c  store particle variables:
1838 
1839 c     i ............. particle number
1840 c     idptl(i) ...... particle id
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 c     pptl(1,i) ..... x-component of particle momentum (GeV/c)
1851       phep(1,nhep)=dble(pptl(1,i))
1852 c     pptl(2,i) ..... y-component of particle momentum (GeV/c)
1853       phep(2,nhep)=dble(pptl(2,i))
1854 c     pptl(3,i) ..... z-component of particle momentum (GeV/c)
1855       phep(3,nhep)=dble(pptl(3,i))
1856 c     pptl(4,i) ..... particle energy  (GeV)
1857       phep(4,nhep)=dble(pptl(4,i))
1858 c     pptl(5,i) ..... particle mass    (GeV/c2)
1859       phep(5,nhep)=dble(pptl(5,i))
1860 c     iorptl(i) ..... particle number of father (if .le. 0 : no father)
1861       if(iorptl(i).gt.0)then
1862         jmohep(1,nhep)=iepo2hep(iorptl(i))
1863       else
1864         jmohep(1,nhep)=-1
1865       endif
1866 c     jorptl(i) ..... particle number of mother (if .le. 0 : no mother)
1867       if(jorptl(i).gt.0)then
1868         jmohep(2,nhep)=iepo2hep(jorptl(i))
1869       else
1870         jmohep(2,nhep)=-1
1871       endif
1872 c     ifrptl(1,i) ..... particle number of first daughter (no daughter=0)
1873       jdahep(1,nhep)=0  !need a second loop to calculated proper indice
1874 c     ifrptl(2,i) ..... particle number of last daughter (no daughter=0)
1875       jdahep(2,nhep)=0  !need a second loop to calculated proper indice
1876 c     istptl(i) ..... generation flag: last gen. (0) or not (1)
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 c     ityptl(i) ..... particle type (string, remnant ...)
1880 c     xorptl(1,i) ... x-component of formation point (fm)
1881       vhep(1,nhep)=xorptl(1,i)*1e-12 !conversion to mm
1882 c     xorptl(2,i) ... y-component of formation point (fm)
1883       vhep(2,nhep)=xorptl(2,i)*1e-12 !conversion to mm
1884 c     xorptl(3,i) ... z-component of formation point (fm)
1885       vhep(3,nhep)=xorptl(3,i)*1e-12 !conversion to mm
1886 c     xorptl(4,i) ... formation time (fm/c)
1887       vhep(4,nhep)=xorptl(4,i)*1E-12 !conversion to mm/c
1888 c     tivptl(1,i) ... formation time (always in the pp-cms!)
1889 c     tivptl(2,i) ... destruction time (always in the pp-cms!)
1890 
1891  100   continue
1892 
1893       endif
1894       enddo
1895 
1896  1000 continue
1897 c Second list to update daughter list (only if mothers are in list)
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 c           ifrptl(1,i) ..... particle number of first daughter (no daughter=0)
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 c           ifrptl(2,i) ..... particle number of last daughter (no daughter=0)
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 c-----------------------------------------------------------------------
1929       subroutine bstora
1930 c-----------------------------------------------------------------------
1931 c     writes the results of a simulation into the file with unit ifdt
1932 c     contains a description of the stored variables.
1933 c-----------------------------------------------------------------------
1934       include 'epos.inc'
1935 C...User process initialization commonblock.
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 C rename .data file .lhe file
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 C...Write header info.
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 C...Set initialization info and get number of processes.
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 C...Copy initialization lines, omitting trailing blanks. 
2123 C...Embed in <init> ... </init> block.
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 c-----------------------------------------------------------------------
2138       subroutine bstore
2139 c-----------------------------------------------------------------------
2140 c     writes the results of a simulation into the file with unit ifdt
2141 c     contains a description of the stored variables.
2142 c-----------------------------------------------------------------------
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 c-----------------------------------------------------------------------
2245       subroutine bread
2246 c-----------------------------------------------------------------------
2247 c     reads the results of a simulation into the file with unit ifdt
2248 c     contains a description of the stored variables.
2249 c-----------------------------------------------------------------------
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 C...User process event common block.
2259       INTEGER MAXNUP
2260       PARAMETER (MAXNUP=50000)  !extend array for file production
2261 c      PARAMETER (MAXNUP=500)
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 c keep the structure of the original event
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 c skip intro
2339  10    read(ifdt,'(a)',end=999)line
2340        if(line(1:7).ne."<event>")goto 10
2341 
2342 c      write(ifdt,'(A)') '<event>' 
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 c optional informations
2374        read(ifdt,*,end=999)line,bimevt,phievt
2375 
2376        read(ifdt,*,end=999)line
2377 
2378 c       read(ifdt,*,end=999)nptevt,bimevt,phievt,kolevt,pmxevt,egyevt
2379 c     *           ,npjevt,ntgevt,qsqevt,typevt
2380 c       if(nptevt.eq.0.or.nptevt.gt.mxptl)then
2381 c         print *,'sorry, '
2382 c         print *,'there is wrong particle number in the event record  '
2383 c         stop
2384 c       endif
2385 c       do n=1,nptevt
2386 c       read(ifdt,*)nidp,idptl(n),pptl(1,n),pptl(2,n),pptl(3,n),pptl(4,n)
2387 c     *            ,pptl(5,n),iorptl(n),jorptl(n),istptl(n),ityptl(n)
2388 c     *            ,xorptl(1,n),xorptl(2,n),xorptl(3,n),xorptl(4,n)
2389 c       inptl(nidp)=n
2390 c       if(iorptl(n).gt.0)iorptl(n)=inptl(iorptl(n))
2391 c       if(jorptl(n).gt.0)jorptl(n)=inptl(jorptl(n))
2392 c       enddo
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 c     if(i.eq.15)read(line(k:),'(i6)') idiptl(n)
2526           if(l.eq.15) k=k+7
2527 c     if(i.eq.16)read(line(k:),'(i6)') idjptl(n)
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 c          if(l.eq.21)read(line(k:),'(I6)') ifrptl(1,n)
2532           if(l.eq.21) k=k+7
2533 c          if(l.eq.22)read(line(k:),'(I6)') ifrptl(2,n)
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 c-----------------------------------------------------------------------
2549       subroutine aafinal
2550 c-----------------------------------------------------------------------
2551 c  * calculates xorptl(j,i), representing formation points.
2552 c    (xorptl(j,i),j=1,4) is the 4-vector representing the space-time of
2553 c    creation of particle i.
2554 c-----------------------------------------------------------------------
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 c            if(ish.ge.4)call alistc('afinal&',i,i)
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 c              call alistc(' ici &',1,i)
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 c-----------------------------------------------------------------------
2594       subroutine afinal
2595 c-----------------------------------------------------------------------
2596 c  does some final calculations, to be called before call aasto.
2597 c  * calculates nptlu, the maximum nptl for all events.
2598 c  * in case of mod(iframe,10) .ne. 1, these vectors are transformed
2599 c    (being originally in the "natural frame",
2600 c    NB : boost of coordinates only if not a non-sense (otherwise put to inf)
2601 c         always boost of momentum if possible (if not STOP !)
2602 c-----------------------------------------------------------------------
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 c Space-time boost
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 c not the electron in lab frame in fake DIS
2648                 if(.not.((abs(iappl).eq.1.or.iappl.eq.3)
2649      *             .and.i.eq.2*(maproj+matarg)+1))then
2650 c put particle from cms to target frame
2651                   call utlob4(-1,pp1,pp2,pp3,pp4,pp5
2652      .                 ,xorptl(1,i),xorptl(2,i),xorptl(3,i),xorptl(4,i))
2653 c do rotation of gamma in proton rest frame
2654                   call utrot4(-1,rgampr(1),rgampr(2),rgampr(3)
2655      .                 ,xorptl(1,i),xorptl(2,i),xorptl(3,i))
2656 c boost in lab frame
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 c Momentum boost
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 c not the electron in lab frame in fake DIS
2679               if(.not.((abs(iappl).eq.1.or.iappl.eq.3)
2680      *           .and.i.eq.2*(maproj+matarg)+1))then
2681 c put particle from cms to target frame
2682                 call utlob5(-yhaha
2683      .     , pptl(1,i), pptl(2,i), pptl(3,i), pptl(4,i), pptl(5,i))
2684 c do rotation of gamma in proton rest frame
2685                 call utrot4(-1,rgampr(1),rgampr(2),rgampr(3)
2686      .               , pptl(1,i), pptl(2,i), pptl(3,i))
2687 c boost in lab frame
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 c      if(isto.eq.1)stop
2721 c$$$      call testconex(2)
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 c-----------------------------------------------------------------------
2754       subroutine bfinal
2755 c-----------------------------------------------------------------------
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 c-----------------------------------------------------------------------
2807       subroutine ainit
2808 c-----------------------------------------------------------------------
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 c update file names
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 ctp060829      if(iopenu.eq.2)call smassi(themas)
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 c        if(model.eq.2.or.model.eq.6)idproj=idtarg   !for qgsjet01, projectile and target are not symetric and we want to look what happen on the projectile side (used for CR)
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 c        if((idtarg.ne.1120.and.(latarg.ne.-1.or.matarg.ne.1))
2971 c     &    .or.matarg.le.0)
2972 c     &  call utstop('Invalid target setup !&')
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 c      pnll=sqrt(max(0., ((engy**2-amproj**2-amtarg**2)/2/amtarg)**2
3003 c     &                   -amproj**2) )
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 c      pnll=sqrt(max(0., ((engy**2-amproj**2-amtarg**2)/2/amtarg)**2
3013 c     &                   -amproj**2) )
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 c   Transfered in epos-con for "koll" dependency
3117 c      if(iappl.le.4.or.iappl.eq.9)then
3118 cc        yrmaxi=max( 0. , yradmx+yradmi*log(engy)**3  )   !better to have a unique definition for extrapolation (based on SPS AA, RHIC and Tevatron pp)  --> but problem at ultra-high energy and from theory we don't know (yet)
3119 c        yrmaxi=max( 0. , yradmx+yradmi*log10(engy/200.)  )
3120 c        if(maproj.eq.1.and.matarg.eq.1)then
3121 c          yrmaxi=max(0.0,yradpp+yradpi*alog10(engy/1800.))
3122 c        endif
3123 c        if(yrmaxi.gt.1e-5)then
3124 c          yyrmax=dble(yrmaxi)
3125 c          fradflii=sngl(1d0/
3126 c     &  ((sinh(yyrmax)*yyrmax-cosh(yyrmax)+1d0)/(yyrmax**2/2d0)))
3127 c        else
3128 c          fradflii=1.
3129 c        endif
3130 c      endif
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 c          call ranfgt(seedp)   !not to change the seed ... not needed with 2 sequence
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 c        if(model.eq.1)call hnbxxxini
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 c      if(iappl.ne.6.and.model.eq.1)call psaini
3190 
3191 c          call ranfst(seedp)                     ! ... after this initialization
3192 
3193         endif       !inicnt=1
3194 
3195 c$$$      if(idproj.eq.1120)icp=2        !????????????? for what ?
3196 c$$$      if(idproj.eq.-1120)icp=-2
3197 c$$$      if(idproj.eq.120)icp=1
3198 c$$$      if(idproj.eq.-120)icp=-1
3199 c$$$      if(idproj.eq.130)icp=4
3200 c$$$      if(idproj.eq.-130)icp=-4
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 c       nptlx=nptl+1
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 c       calculates numbers of spectators:
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 c Form nuclear fragments
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 c      call timer(iutime)
5570 c      timefin=iutime(3)+float(iutime(4))/1000.
5571       call utprix('aepos',ish,ishini,4)
5572       return
5573       end
5574 
5575 c-----------------------------------------------------------------------
5576       subroutine cleanup
5577 c-----------------------------------------------------------------------
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 c-----------------------------------------------------------------------
5605       subroutine emsaaa(iret)
5606 c-----------------------------------------------------------------------
5607 c  basic EMS routine to determine Pomeron configuration
5608 c-----------------------------------------------------------------------
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 c----------------------------------------------------------------------
5645       subroutine alist(text,n1,n2)
5646 c----------------------------------------------------------------------
5647 c    ior  jor  i  ifr1  ifr2     id  ist  ity      pt  m  y
5648 c----------------------------------------------------------------------
5649 c       ist                                     ity
5650 c                                  light cluster ........ 19
5651 c   ptl ...  0 1                   soft pom ............. 20-23   25(reggeon)
5652 c   clu ... 10 11                  hard pom low mass .... 30
5653 c   ptn ... 20 21                  proj remnant ......... 40-49
5654 c   str ... 29                     targ remnant ......... 50-59
5655 c   pom ... 30 31 32(virtual)      cluster .............. 60
5656 c   rem ... 40 41                  direct photon ........ 71,72
5657 c----------------------------------------------------------------------
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 c      parameter(itext=40)
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 c        if(istptl(i).ne.12)write(ifch,*)' '
5711 c        if(istptl(i).eq.12)write(ifch,'(1x,3(e9.3,1x))')
5712 c     &           sptl(i),sqrt(uptl(i)-xorptl(1,i)**2)
5713 c     &            ,sqrt(optl(i)-xorptl(2,i)**2)
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 c----------------------------------------------------------------------
5729       subroutine blist(text,n1,n2)
5730 c----------------------------------------------------------------------
5731       include 'epos.inc'
5732 c      parameter(itext=40)
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 c----------------------------------------------------------------------
5793       subroutine clist(text,n1,n2,ity1,ity2)
5794 c----------------------------------------------------------------------
5795       include 'epos.inc'
5796 c      parameter(itext=40)
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 c----------------------------------------------------------------------
5835       subroutine alistf(text)
5836 c----------------------------------------------------------------------
5837       include 'epos.inc'
5838 c      parameter(itext=40)
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 c     &,(xorptl(j,i),j=1,4)
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 c----------------------------------------------------------------------
5922       subroutine alist2(text,n1,n2,n3,n4)
5923 c----------------------------------------------------------------------
5924       include 'epos.inc'
5925 c      parameter(itext=40)
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 c     &,(xorptl(j,i),j=1,4)
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 c     &,(xorptl(j,i),j=1,4)
5941       enddo
5942  125  format (1x,i6,i6,3x,i6,3x,i6,i6,i12,2i4,4x,5(e8.2,1x))
5943 c     *,4x,4(e8.2,1x))
5944       end
5945 
5946 c----------------------------------------------------------------------
5947       subroutine alistc(text,n1,n2)
5948 c----------------------------------------------------------------------
5949       include 'epos.inc'
5950 c      parameter(itext=40)
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 c-----------------------------------------------------------------------
5966       subroutine sigmaint(g0,gz,sigdo)
5967 c-----------------------------------------------------------------------
5968 c hadron-hadron cross sections integration
5969 c-----------------------------------------------------------------------
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 c       rs=r2had(iclpro)+r2had(icltar)+slopom*log(engy**2)
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 c        cpt=chad(iclpro)*chad(icltar)
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 c           vvv11=sqrt(vvv21)
6018 c           vvv12=sqrt(vvv21)
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 c-----------------------------------------------------------------------
6059       subroutine xsigma
6060 c-----------------------------------------------------------------------
6061 c hadron-hadron and hadron-nucleus cross sections calculation
6062 c b - impact parameter squared (in case of hadron-nucleus interaction);
6063 c-----------------------------------------------------------------------
6064       include 'epos.inc'
6065       include 'epos.incsem'
6066       double precision gz(0:3),gzp(0:3),GZ0(2)
6067 c Model 2 Common
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 C...Total cross sections in Pythia
6076       double precision SIGT
6077       COMMON/PYINT7/SIGT(0:6,0:6,0:5)
6078 
6079 c Model 5 Common
6080       COMMON/HIPARNT/HIPR1(100), IHPR2(50), HINT1(100), IHNT2(50)
6081 
6082 c theoretical cross sections
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 c simulated cross sections
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 c fit to data
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 c        sigtotfp=sigtotf
6127 c        sigelafp=sigelaf
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 c        sigdelaf=max(0.,(sigelaf-sigelaold))
6148         edlim=0.015
6149         if(rexdifi(iclpro).lt.0..or.rexdifi(icltar).lt.0.)then
6150 c          print *,'sig',sigdelaf,sigdif,sigelaf,sigineold,sigtotf
6151           sigdela=min(sigdelaf,sigdif)
6152 
6153 c calculate rexdif for proton first (always needed)
6154           if(rexdifi(icltar).lt.0.)then
6155 c use fit of sigela to get rexdif
6156             if(engy.lt.min(30.,-log(-rexdifi(icltar))/edlim))then
6157 c pi or K - p, calculate sigdif for pp
6158               if(iclpro+icltar.ne.4)then 
6159                 iclprosave=iclpro
6160                 iclpro=2
6161                 call sigmaint(g0p,gzp,sigdifp)
6162 c                siginep=g0p*gzp(2)
6163                 sigdifp=sigdifp * g0p
6164 c                sigdelafp=max(0.,(sigelafp+siginep-sigtotfp))
6165 c                sigdelap=min(sigdelafp,sigdifp)
6166                 iclpro=iclprosave
6167               else
6168                 sigdifp=sigdif
6169 c                sigdelafp=sigdelaf
6170 c                sigdelap=sigdela
6171               endif
6172               if(sigdifp.gt.0.)then
6173 c                ratioSig=sigdelap/sigdifp
6174 c                rexdif(icltar)=1.-sqrt(ratioSig)
6175 c                if(rexdif(icltar).ge.exp(-edlim*engy))
6176 c     &               rexdif(icltar)=exp(-edlim*engy)
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 c        rexdif(icltar)=max(exp(-1.7/engy**0.3),abs(rexdifi(icltar)))  !strong reduction
6184 c        rexdif(icltar)=max(exp(-0.33/engy**0.066),abs(rexdifi(icltar))) !moderate one (constant sig NSD)
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 c              ratioSig=sigdela/sigdif
6196 c              if(abs(1.-rexdif(icltar)).gt.1.e-6)then
6197 c                rexdif(iclpro)=1.-ratioSig/(1.-rexdif(icltar))
6198 c              else
6199 c                rexdif(iclpro)=abs(rexdifi(iclpro))
6200 c              endif
6201 c              if(rexdif(iclpro).ge.exp(-edlim*engy))
6202 c     &             rexdif(iclpro)=exp(-edlim*engy)
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 c          rexdif(iclpro)=max(exp(-1.7/engy**0.3),abs(rexdifi(iclpro))) !strong reduction
6209 c         rexdif(iclpro)=max(exp(-0.33/engy**0.066),abs(rexdifi(iclpro)))  !moderate one (constant sig NSD)
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 c        if(rexndf.gt.0..and.iclpro.eq.2)then
6228         if(rexndf.gt.0.)then
6229           rexndi(iclpro)=rexndf*rexdif(iclpro)
6230         else
6231           rexndi(iclpro)=rexndii(iclpro)
6232         endif
6233 c        if(rexndf.gt.0..and.icltar.eq.2)then
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 c        if(engy.lt.10.)sigela=max(sigelaf,sigela)
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 c        write(ifmt,*)'Rexdif',rexdif(iclpro),rexdif(icltar)
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 c GDP - projectile diffraction cross section
6271         GDP=(1.D0-CC(ICZ))*CC(2)*gz(0)
6272 c GDT - target diffraction cross section
6273         GDT=(1.D0-CC(2))*CC(ICZ)*gz(0)
6274 c  GDD - double diffractive cross section
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 c (from tabulation) for pA/AA
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 c eposcrse depends of ionudi while eposinecrse corresponds to ionudi=1 always
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 c First order approximation. Better to use isigma=2 for that
6395               difpart=max(0.,sigineaa-sigcutaa)
6396 c  non excited projectile
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 c  non excited target
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 c  excited diffractive part
6417               sigqela=sigqela*difpart
6418               sigineaa=sigineaa-sigqela
6419               sigelaaa=sigelaaa+sigqela
6420 c here cut is absorbtion xs : cut + 95 % of excited diff.
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