cintModels.f

Go to the documentation of this file.

!      *******************
      subroutine cintmodels(from)
!
!           establish the energy bound for the given interaction model.
!          and corresponding init.
      implicit none
#include  "Zmanagerp.h"
#include  "Zmanager.h"
#include  "Zevhnp.h"
#include  "Zptcl.h"
#include  "Zevhnv.h"
      
      character*(*)  from  ! input. cosmos or epics ; from which 

      integer i, j
      character*100 path

      cosorepi = from
      call cgettopdir   ! get Cosmos top dir and set it in Zmanager.h

      do i = 1, maxintmdls
         modellist(i) = ' '
         inteerg(i) = 2.d12  ! GeV 10^21 eV
         modellist2(i) = ' '
         inteerg2(i) = 2.d12  ! GeV 10^21 eV
      enddo
!             ModelList       InteErg
!              "xxx"            100.
!              "yyy"            1.d12      ====>  xxx if E< 100  else yyy
!
!              "xxx"            1.d12      ====>  xxx at entier energy.
!
      intmodel(64:64) = '/'
      if( xsecmodel == " ") then
         xsecmodel = intmodel
      else
         xsecmodel(64:64) = '/'
      endif
 
      read(intmodel, *, err=100)
     *    (modellist(i), inteerg(i), i=1, maxintmdls)
      read(xsecmodel, *, err=100)
     *    (modellist2(i), inteerg2(i), i=1, maxintmdls)

      do i = 1, maxintmdls
         if(modellist(i) .eq. ' ') then
            noofmdls = i-1
            goto 10
         endif
      enddo
      noofmdls = maxintmdls
 10   continue
      do i = 1, maxintmdls
         if(modellist2(i) .eq. ' ') then
            noofmdls2 = i-1
            goto 20
         endif
      enddo
      noofmdls2 = maxintmdls
 20   continue

      do i = 1, noofmdls-1
!         if(InteErg(i) .ge. InteErg(i+1)) then
         if(inteerg(i) > inteerg(i+1)) then  ! v7.633
!                 energy region invalid
            call cerrormsg(
     *           'IntModel is invalid; energy region not ascending', 1)
            call cerrormsg(intmodel, 0)
         elseif(inteerg(i) == inteerg(i+1)) then ! v7.633
!             a model written between(i) and (i+1)
!             will not be used explicitly but initialization
!             is tried. It might be used as a rescuee when a
!             some model cannot cope with a specific particle.
            ! issue some message
            write(0,*) '================================='
            write(0,*)
     *        i,'-th and ',i+1,'-th energy in IntModel are same' 
            write(0,*) 'The model specified is ',modellist(i+1), '.'
            write(0,*) 'It will not be used explicitly but might be'
            write(0,*) 'used when some model needs help for a '
            write(0,*) 'specific particle. dpmjet3 is a good  ' 
            write(0,*) 'candidate of such a model'
            write(0,*) '================================='
         endif

      enddo
      if( noofmdls2 /=  noofmdls .or.
     &    any(inteerg(1:noofmdls) /= inteerg2(1:noofmdls)) ) then
         do i = 1, noofmdls2-1
            if(inteerg2(i) > inteerg2(i+1)) then  
!                 energy region invalid
               call cerrormsg(
     *           'XsecModel is invalid; energy region not ascending', 1)
               call cerrormsg(xsecmodel, 0)
            elseif(inteerg2(i) == inteerg2(i+1)) then
             write(0,*) '================================='
             write(0,*)
     *        i,'-th and ',i+1,'-th energy in IntModel are same' 
             write(0,*) 'The model specified is ',modellist2(i+1), '.'
             write(0,*) 'It will not be used explicitly but might be'
             write(0,*) 'used when some model needs help for a '
             write(0,*) 'specific particle. dpmjet3 is a good  ' 
             write(0,*) 'candidate of such a model'
             write(0,*) '================================='
          endif
       enddo
      endif
!         exam models
      do i = 1, noofmdls
         do j = 1, nmdls
            if( modellist(i) .eq.  regmdls(j) ) goto 25
         enddo
         call cerrormsg( modellist(i),  1)
         call cerrormsg('above model is not yet registered', 0)
 25      continue
      enddo
!         exam models
      do i = 1, noofmdls2
         do j = 1, nmdls
            if( modellist2(i) .eq.  regmdls(j) ) goto 28
         enddo
         call cerrormsg( modellist2(i),  1)
         call cerrormsg('above model is not yet registered', 0)
 28      continue
      enddo

!
      if( index(intmodel, 'fritiof1.6') .gt. 0 .or.
     *    index(intmodel, 'nucrin') .gt. 0  .or.
     *    index(intmodel, 'dpmjet3') .gt. 0  .or.
     *    index(intmodel, 'incdpm3') .gt. 0  .or.
     *    index(intmodel, 'jam') .gt. 0  ) then

!           for Lund init.  dpm may use Lund at low energy or
!                                    for some particles
         call haddenc
         call chanwnc
      endif
      if( index(intmodel, 'phits') .gt. 0  .or.
     *    index(xsecmodel, 'phits') .gt. 0 ) then
         call cprephits
      endif
      if( index(intmodel, 'qgsjet2') .gt. 0 .or.
     *    index(xsecmodel, 'qgsjet2') .gt. 0 ) then
         call ciniqgs
      endif
      if( index(intmodel, 'epos') .gt. 0 .or.
     *    index(xsecmodel, 'epos') .gt. 0 ) then
         call ceposiniall
      endif
      if( index(intmodel, 'sibyll') > 0 .or.
     *    index(xsecmodel, 'sibyll') > 0 ) then
         call csibyllinit
      endif
      if( index(intmodel, 'incdpm3') .gt. 0 ) then
         call ciniincdpm3
      endif

      if( index(intmodel, 'gheisha' ) .gt. 0) then
!         Gheisha; init. Gheisha cannot use hadrin/nucrin in Cosmos
         call gpart
         call gheini
      endif
      if( index(intmodel, 'jam' ) .gt. 0) then
         ! nothing to do ?
      endif
      if( index(intmodel, 'dpmjet3') .gt. 0 .or.
     *    index(xsecmodel, 'dpmjet3') .gt. 0  .or.
     *    index(intmodel, 'incdpm3') .gt. 0  ) then
         if(from .eq. 'cosmos') then
            ! init for dpmjet.  for Cosmos
            ! If DpmFile is ' ',
            ! $COSMOSTOP/Data/atmos.inp is the control card for dpmjet3.
            If( dpmfile  .eq.  ' ' ) then
               call cformfullpath('atmos.inp', path)
               call cinidpmjet(path)
            else
               call cinidpmjet(dpmfile)
            endif
         elseif(from .eq. 'check') then
!           it is assumed that the Glauber file is
!           specified by prefix/...GLB

         elseif(from == 'epics' .or. from == 'gencol') then
!              dpmjet.inp is assumed in the same directory
!              as config file.
            call cformfullpath('dpmjet.inp', path)
            call cinidpmjet(path)
         else
            call cerrormsg(from, 1)
            call cerrormsg('above "from" in cintModels invalid',0)
         endif
      endif
      return

 100  continue
      call cerrormsg(
     * 'IntModel syntax error; prob.missing " mark'//
     * ' for string; IntModel is', 1)
      call cerrormsg(intmodel, 0)
      end

!           
!          next is for dpmjet file management.
!          dpmfiles for Epcis is assumed to be in the
!          same directory as config file resides so
!          extract the directory where the config file is.
      subroutine cfixprefix(dsn)
      implicit none
#include "Zmanager.h"
      character*(*) dsn   ! input. config file name or path
!            output. PrefixConf= './' or '/.../.../' where
!                              config file exist.
!                    PrefixLeng is it's length. 
!      
!
      integer i, j, klena, k

      if( index(dsn, '/') .eq. 0 ) then
         prefixconf = './'
         prefixleng = 2
      else
!             find last '/'
         i = klena(dsn)
         do j = i, 1, -1
            k = index(dsn(j:j), '/')
            if( k .gt. 0 ) then
               prefixconf = dsn(1:j)
               prefixleng = j
               goto 33
            endif
         enddo
      endif
 33   continue
      end
!         ***********  get Cosmos Top director
!             and set it in TopDir in Zmanager.h
      subroutine cgettopdir
      implicit none
#include "Zmanager.h"


      character*1 NULL
      integer  kgetenv

      null = char(0)
      topdir = ' '
      topdirleng = kgetenv("COSMOSTOP"//null, topdir)
      end

      subroutine csetcosorepi(from)
      implicit none
#include "Zmanager.h"
      character*(*) from   !  input. cosmos or epics
       cosorepi = from
       end

      subroutine cformfullpath(file, path)
      implicit none
#include "Zmanager.h"
      character*(*) file   !  input. file name
      character*(*) path   ! output. $COSMOSTOP/Data/DPM/file  
      integer klena

      path = ' '

      if(cosorepi .eq. 'cosmos') then
         path = topdir(1:topdirleng)//'/Data/DPM/'
     *     //file(1:klena(file))
      elseif(cosorepi == 'epics' .or. cosorepi == 'check'
     * .or. cosorepi == 'gencol') then
         path = prefixconf(1:prefixleng)//file(1:klena(file))
      else
         call cerrormsg(
     *   "cintModels('cosmos') or cintModels('epics')"//
     *   " must have been called ", 0)
      endif

      end
      subroutine cputgencolcms(cms)
!           this is introduced for EPOS
!     to save the single precision boost in EPOS
!     call afinal is avoided to convert cms to lab
!     conversion of which result becomes not accurate 
!     if we convet it to cms again. (Gencol needs to do so)
!
      implicit none
#include "Zptcl.h"
      type(ptcl):: cms ! input. Gencol must
                      ! inform the cms (/n)

      common /forgencol/ cmssave
      type(ptcl):: cmsSave
      cmssave = cms
      end
      subroutine cqgencolcms(cms)
!      ask gencol cms
!
      implicit none
#include "Zptcl.h"
      type(ptcl):: cms  ! outut. 
      common /forgencol/ cmssave
      type(ptcl):: cmsSave
      cms = cmssave 
      end