softenpik Module Reference

Functions/Subroutines
subroutine	cjudgesplit (pj, x, split)
subroutine	csoftenpik (inciptcl, pstore, nin, nout)
subroutine	csoftenpik0 (inciptcl, pstore, nin, nout, exist)
subroutine	csoftenpik1 (inciptcl, pstore, nin, nout, exist)
subroutine	csplitmeson (p, E1, E2, icon)
subroutine	cae2p (pc)
subroutine	cgetmaxptcl (pstore, nin, pcode, pcharge, maxi, maxE)
subroutine	csoftenfe (inci, fwbwin, a, nin, nout)
subroutine	creadsoftenpara (io)
subroutine	cwritesoftenpara (io)
subroutine	cskipsep (io)
subroutine	creadparar (vvalue, x)
subroutine	creadparar2 (vvalue, x, n)
subroutine	creadparacx (vvalue, c)
subroutine	creadparai (vvalue, i)
subroutine	creadparac (vvalue, cha)
subroutine	creadparal (vvalue, logi)
subroutine	cwriteparar (io, vname, x)
subroutine	cwriteparar2 (io, vname, x, n)
subroutine	cwriteparacx (io, vname, c)
subroutine	cwriteparai (io, vname, i)
subroutine	cwriteparac (io, vname, cha)
subroutine	cwriteparal (io, vname, logi)
real(8) function	crejk1 (x)
real(8) function	cxthu (E0)
real(8) function	ck1u (E0)
logical function	cgetparmn (io, vname, vv)
real(8) function	csoftenfixxth (E0)

Variables
integer, save	mode = 3
real(8), save	xth = 0.05
real(8), save	pw = 0.5
real(8), save	repeat = 2.5
real(8), save	e0th = 500.
integer, save	fwbw = 3
logical, save	special =.false.
logical, save	leadingpik =.true.
logical, save	usexincms =.false.
real(8), save	k1u =0.25
real(8), save	xthl =1.d0
real(8), save	xthu =10.d0
real(8), save	rejpw =0.
logical, save	modified
real(8), save	e0lab =1.e12
integer, parameter	half =12000

Function/Subroutine Documentation

cae2p()

subroutine cae2p

(

type(ptcl)

pc

)

Definition at line 501 of file csoftenPiK.f.

References mass, and p.

Referenced by csoftenpik0(), and csoftenpik1().

!             adjust mpmentum by refering to changed E
!         keep the Pt same, if possible
      implicit none
#include  "Zcode.h"
#include  "Zptcl.h"


      type(ptcl):: pc
      
      real(8):: e,  p2, cf

      e = pc.fm.p(4)
!      
!         Pt^2 + Pz^2 +m^2= E^2
!         so new Pz =sqrt( E^2-Pt^2-m^2) 
!          the sign is the same as original one
      p2 =e**2- ( pc.fm.p(1)**2  + pc.fm.p(2)**2 + pc.mass**2)
      if( p2 > pc.mass**2  ) then
         pc.fm.p(3) =  sign(sqrt(p2), pc.fm.p(3))
      else
!         keep the direction and shirnk the magnitude of p
         p2 = pc.fm.p(1)**2  + pc.fm.p(2)**2  + pc.fm.p(3)**2
         if( e <= pc.mass .or. p2 == 0. ) then
            pc.fm.p(1:3) = 0.         
         else
            cf = sqrt( (e**2 - pc.mass**2) / p2 )
            pc.fm.p(1:3) = pc.fm.p(1:3)*cf
         endif
      endif

Here is the caller graph for this function:

cgetmaxptcl()

subroutine cgetmaxptcl	(	type(ptcl), dimension(nin)	pstore,
		integer, intent(in)	nin,
		integer(2), intent(in)	pcode,
		integer(2), intent(in)	pcharge,
		integer, intent(out)	maxi,
		real(8), intent(out)	maxE
	)

Definition at line 532 of file csoftenPiK.f.

References charge, code, and p.

Referenced by csoftenpik0(), and csoftenpik1().

!        get max energy ptcl with the same code / charge as incident
!        if meson is incident, most probably, it is leading.
      implicit none
#include  "Zcode.h"
#include  "Zptcl.h"

      integer,intent(in):: nin ! # of ptcls in pstore
      type(ptcl):: pstore(nin) 
      
      integer(2),intent(in):: pcode    ! incident code
      integer(2),intent(in):: pcharge  ! //       charge
      integer,intent(out):: maxi  !   index of maxE in pstore  // 
      real(8),intent(out):: maxe   ! max Energy with the same code/charg as
                              ! incident.  if there is no such, 0


      integer i

      maxi = 0
      maxe = 0.
      do  i = 1,  nin
         if( pstore(i).code /=  pcode ) cycle
         if( pstore(i).charge /= pcharge ) cycle
         if( maxe < pstore(i).fm.p(4) ) then
            maxe =  pstore(i).fm.p(4) 
            maxi = i
         endif
      enddo

Here is the caller graph for this function:

cgetparmn()

logical function cgetparmn	(	integer	io,
		character*(*)	vname,
		character*(*)	vv
	)

Definition at line 813 of file csoftenPiK.f.

References false, parameter(), and true.

!          get parameter variable name and given value(s)  from io
       implicit none
       integer io
       character*(*)  vname, vv  ! output
       logical ans

       integer linel
       parameter( linel = 100)
       character*(linel)  line
       integer loc, loc2
       vname = " "
       do while(.true.)
          read(io, '(a)', end=100 ) line
          if( line(1:1) .eq. " " .and. line(2:2) .ne. " ") then
             loc = index( line(3:linel), " ")  + 2
             vname = line(2:loc-1)
             loc2 = index( line, "/")
             if(loc2 .eq. 0 ) then
                write(0,* ) ' "/"  is missing in the input data file '
                write(0,*)  ' The line is: ', line
                stop 1234
             endif
             vv = line(loc+1:linel)  !  some data containes '/' such as '../../Media' so put all
                                     ! data.
             goto 50
          endif
       enddo
 50    continue
       ans = .true.
       return
 100   continue
       ans =.false.

Here is the call graph for this function:

cjudgesplit()

subroutine cjudgesplit	(	type(ptcl)	pj,
		real(8), intent(in)	x,
		logical, intent(out)	split
	)

Definition at line 114 of file csoftenPiK.f.

References mode, pw, rndc(), and xth.

Referenced by csoftenpik0().

      implicit none
!         judge if this x should be split
#include "Zptcl.h"
      type(ptcl):: pj    ! input. projectile. you may use this
      real(8),intent(in):: x  ! KE ratio
      logical,intent(out):: split  ! .true.  or .false.. if true, split meson

      real(8):: u

      if( mode == 3) then
         call rndc(u)   ! uniform rn in (0,1)
!          if pw in (x-xth)**pw is smaller, stronger softening
         split = (x-xth)**pw  > u  
      elseif(mode == -3 ) then
!            comment out next lines and supply your judgement
!         and fix split (.true. or .false.)
!         you may use xth, pw etc which are defined before "contains"
         write(0,*) ' you have to supply your owon code here'
         write(0,*) ' to judge if this particle should be '
         write(0,*) ' split or not' 
         write(0,*)
     *    ' Place is cJudgeSplit; first subroutine in  csoftenPiK'
         stop
      endif
         

Here is the call graph for this function:

Here is the caller graph for this function:

ck1u()

real(8) function softenpik::ck1u

(

real(8), intent(in)

E0

)

Definition at line 806 of file csoftenPiK.f.

Referenced by csoftenpik().

      implicit none
      real(8),intent(in):: e0 ! lab E0 in Gev
      real(8):: ans   !  k1u
      ans = 0.3*(e0/1.e8)**0.09

Here is the caller graph for this function:

creadparac()

subroutine creadparac	(	character*(*)	vvalue,
		character*(*)	cha
	)

Definition at line 720 of file csoftenPiK.f.

      implicit none
      character*(*) vvalue
      character*(*) cha
      read(vvalue, *)  cha

creadparacx()

subroutine creadparacx	(	character*(*)	vvalue,
		complex*8	c
	)

Definition at line 706 of file csoftenPiK.f.

      implicit none
      character*(*) vvalue
      complex*8 c
      read( vvalue, *)   c

creadparai()

subroutine creadparai	(	character*(*)	vvalue,
		integer	i
	)

Definition at line 713 of file csoftenPiK.f.

      implicit none
      character*(*) vvalue
      integer i
      read(vvalue, *)   i

creadparal()

subroutine creadparal	(	character*(*)	vvalue,
		logical	logi
	)

Definition at line 727 of file csoftenPiK.f.

      implicit none
      character*(*) vvalue
      logical logi
      read(vvalue, *)  logi

creadparar()

subroutine creadparar	(	character*(*)	vvalue,
		real*8	x
	)

Definition at line 688 of file csoftenPiK.f.

        implicit none
        integer io
        character*(*) vvalue
        real*8 x
!        read(vvalue, *)   x, x
        read(vvalue, *)   x

creadparar2()

subroutine creadparar2	(	character*(*)	vvalue,
		real*8, dimension(n)	x,
		integer	n
	)

Definition at line 696 of file csoftenPiK.f.

        implicit none
        integer io
        character*(*) vvalue
        integer n
        real*8 x(n)
        read(vvalue, *)   x

creadsoftenpara()

subroutine creadsoftenpara

(

integer, intent(in)

io

)

Definition at line 617 of file csoftenPiK.f.

References cgetparmn(), creadparai(), creadparal(), creadparar(), cskipsep(), e0th, fwbw, k1u, leadingpik, mode, pw, rejpw, repeat, special, usexincms, xth, xthl, and xthu.

      implicit none
      integer,intent(in):: io   ! logical dev. #
      character*24 vname
      character*100 vvalue


       call cskipsep(io)
       do while( cgetparmn(io, vname, vvalue ) )
          select case(vname)
          case('mode')
             call creadparai(vvalue, mode)
          case('xth') 
             call creadparar(vvalue, xth)
          case('E0th') 
             call creadparar(vvalue, e0th)
          case('fwbw')
             call creadparai(vvalue, fwbw)
          case('pw')
             call creadparar(vvalue, pw)
          case('repeat')
             call creadparar(vvalue, repeat)
          case('special')
             call creadparal(vvalue, special)
          case('leadingPiK')
             call creadparal(vvalue, leadingpik)
          case('useXinCMS')
             call creadparal(vvalue, usexincms)
          case('k1u')
             call creadparar(vvalue, k1u)
          case('xthl')
             call creadparar(vvalue, xthl)
          case('xthu')
             call creadparar(vvalue, xthu)
          case('rejpw')
             call creadparar(vvalue, rejpw)
          end select
       enddo

Here is the call graph for this function:

crejk1()

real(8) function softenpik::crejk1

(

real(8), intent(in)

x

)

Definition at line 792 of file csoftenPiK.f.

References rejpw, xth, xthl, and xthu.

Referenced by csoftenpik1().

      implicit none
      real(8),intent(in):: x
      real(8):: ans
      ans = ( log(x/(xth/xthu)) * log((xth*xthl)/x) )**rejpw

Here is the caller graph for this function:

cskipsep()

subroutine cskipsep

(

integer

io

)

Definition at line 678 of file csoftenPiK.f.

References true.

       implicit none
       integer io
       character(10)  sep
       do while (.true.)
          read(io, '(a)') sep
          if(sep(2:10) == '---------') exit
       enddo

csoftenfe()

subroutine csoftenfe	(	type(ptcl)	inci,
		integer, intent(in)	fwbwin,
		type(ptcl), dimension(*)	a,
		integer, intent(in)	nin,
		integer, intent(out)	nout
	)

Definition at line 563 of file csoftenPiK.f.

References csoftenpik(), and p.

Referenced by __gencol.f__(), and cutptcl().

!       front end of softening when it is to be  done at CMS
!         x is defined simply by E/E0, 
      implicit none 
#include "Zptcl.h"      
      type(ptcl):: inci  ! incident ptcl (in cms); symmetric case 
      integer,intent(in):: fwbwin  ! modification is applied to
                                 ! 1--> forward only 2--> backword only
                                 ! 3--> both ; However, 1 is used when
                     ! Cosmos output (in cms) is the target, independently of
                     ! fwbw.  
      type(ptcl):: a(*)  ! array containing ptcl info.
      integer,intent(in)::nin ! # of ptcls in w
      integer,intent(out)::nout ! # of ptcls put in w after modification

      type(ptcl):: w1(half)  ! working array
      type(ptcl):: w2(half)  ! working array

      integer::i, nc1, nc2, ncout1, ncout2

!       do modification  extract Pz>0  and Pz<0
      nc1 = 0
      nc2 = 0
      do i = 1, nin
         if(a(i).fm.p(3) > 0.) then
            nc1 = nc1 + 1
            w1(nc1) = a(i)
         else
            nc2 = nc2 + 1
            w2(nc2) = a(i)
         endif
      enddo
      if( nc1 > 0 .and. ibits(fwbwin,0,1)>0 ) then  ! LSB pos=0
         call csoftenpik(inci, w1, nc1, ncout1)
      else
         ncout1 = nc1
      endif
      if( nc2 > 0 .and. ibits(fwbwin,1,1)>0 ) then  ! 2nd bit pos=1
         call csoftenpik(inci, w2, nc2, ncout2)
      else
         ncout2 = nc2
      endif

      nout = 0
      do i = 1, ncout1
         nout = nout + 1
         a(nout) = w1(i)
      enddo
      do i = 1, ncout2
         nout = nout + 1
         a(nout) = w2(i)
      enddo

Here is the call graph for this function:

Here is the caller graph for this function:

csoftenfixxth()

real(8) function softenpik::csoftenfixxth

(

real(8), intent(in)

E0

)

Definition at line 848 of file csoftenPiK.f.

References d0.

Referenced by csoftenpik().

      implicit none
      real(8),intent(in)::e0 ! proton/pi/K incident E. in GeV
      real(8):: xth !
!        fix the xth above which softening is performed
!       at 10^12 eV:  0.1 
!          10^13      0.063
!          10^14      0.04
!          10^16     0.01585
!          10^17      0.01
!          10^19      0.004
      xth = 0.1d0/(e0/1000.d0)**0.2

Here is the caller graph for this function:

csoftenpik()

subroutine csoftenpik	(	type(ptcl)	inciptcl,
		type(ptcl), dimension(*)	pstore,
		integer, intent(in)	nin,
		integer, intent(out)	nout
	)

Definition at line 142 of file csoftenPiK.f.

References ck1u(), copenf(), creadsoftenpara(), csoftenfixxth(), csoftenpik0(), csoftenpik1(), cwritesoftenpara(), cxthu(), e0lab, false, k1u, kpoisn(), repeat, rndc(), xth, and xthu.

Referenced by csoftenfe(), and cutptcl().

!         inciptcl made a collsion and generated nin particles in pstore
!         particle information may be at CMS or Lab.
!     If we want to  make the x-dist. softer,
!      A) For Cosmos (air target),  we may use the Lab system
!         (for large X, the distribution would be the same 
!           as CMS)
      implicit none
#include  "Zcode.h"
#include  "Zptcl.h"
#include  "Zmanagerp.h"
      type(ptcl):: inciptcl  ! input. incident ptcl at collision
!                  
      integer,intent(in)::nin ! # of ptcls in pstore 
      type(ptcl):: pstore(*)  ! input/output.   ptcls to be softened.
                           !     Softened ones are put here
      integer,intent(out)::nout ! # of ptcls re-stored in pstore 
      logical,save::first=.true.
      integer:: jcon, i
      integer:: nrepeat
      real(8):: u
      integer:: exist
      integer:: nnow
      
      if( first ) then
         call copenf(tempdev, 
     *       "$COSMOSTOP/UserHook/modifyX/softenparam.dat", jcon)
         if( jcon /= 0 ) then
            write(0,*) 'Data file for csoftenPiK could not be found'
            write(0,*) 'in $COSMOSTOP/Util/Data/softenpiK.dat'
            write(0,*) 'Forgot to set COSMOSTOP ?'
            stop
         else
            call creadsoftenpara(tempdev)
         endif
         call cwritesoftenpara(0)
         first = .false.
      endif
      if( repeat < 0. ) then
         call kpoisn(-repeat, nrepeat)
      else
         call rndc(u)
         nrepeat = repeat
         if( u < repeat-nrepeat)  then
            nrepeat = nrepeat + 1
         endif
      endif

      nnow = nin
      xth = csoftenfixxth(e0lab)
      k1u = ck1u(e0lab)
      xthu =cxthu(e0lab)
      do i = 1, nrepeat
         call csoftenpik0(inciptcl, pstore, nnow, nout, exist)
         if( exist == 0 ) exit 
         nnow = nout
      enddo
      do i = 1, 1
         call csoftenpik1(inciptcl, pstore, nnow, nout, exist)
         if( exist == 0 ) exit 
         nnow = nout
      enddo

Here is the call graph for this function:

Here is the caller graph for this function:

csoftenpik0()

subroutine csoftenpik0	(	type(ptcl)	inciptcl,
		type(ptcl), dimension(*)	pstore,
		integer, intent(in)	nin,
		integer, intent(out)	nout,
		integer, intent(out)	exist
	)

Definition at line 207 of file csoftenPiK.f.

References cae2p(), cgetmaxptcl(), charge, cjudgesplit(), code, csplitmeson(), e0lab, e0th, keta, kkaon, kpion, leadingpik, mass, mode, modified, p, true, and xth.

Referenced by csoftenpik().

!         inciptcl made a collision and generated nin particles in pstore
!         particle.  information may be at CMS or Lab.
!     If we want to  make the x-dist. softer,
!      A) For Cosmos (air target),  we may use the Lab system
!         (for large X, the distribution would be the same 
!           as CMS)
      implicit none
#include  "Zcode.h"
#include  "Zptcl.h"

      type(ptcl):: inciptcl  ! input. incident ptcl at collision
!                  
      integer,intent(in)::nin ! # of ptcls in pstore 
      type(ptcl):: pstore(*)  ! input/output.   ptcls to be softened.
                           !     Softened ones are put here
      integer,intent(out)::nout ! # of ptcls re-stored in pstore 
      integer,intent(out)::exist  ! # of particcls with X> Xth
! ----------------------------------------------
      type(ptcl):: work(2)
      logical  ok
      integer::maxi
      real(8)::maxe
      integer::i, j 
      real(8):: x, e0, ex, u, u1, u2     
      real(8):: e1, e2
      real(8)::temp
      integer:: nc  ! counting # of ptcls in pstore
      integer:: nw, icon
      logical:: split 

      e0 = inciptcl.fm.p(4) - inciptcl.mass
      nout = nin
      exist = 0
      if( e0lab < e0th) return      !!!!!
      nc = nin
!            if pi/K is incident, regards the highest one as leading
!            and avoid to modify 
      if(leadingpik .and. (inciptcl.code == kpion .or.
     *     inciptcl.code == kkaon ) ) then
!              find max energy ptcl index and E; eta cannot be incident
         call cgetmaxptcl(pstore, nc, inciptcl.code, inciptcl.charge,
     *        maxi, maxe)
      else
         maxi = 0
      endif

      do i = 1, nin
         x = (pstore(i).fm.p(4)-pstore(i).mass)/e0
         if( abs(mode) == 3 ) then
            if( i /= maxi ) then
!                softening
               if(x > xth ) then
!                  modify high X of pi/K/eta
                  if(pstore(i).code == kpion .or.
     *                 pstore(i).code == kkaon 
     *                 .or.   pstore(i).code ==  keta ) then
                     nw = 0
                     exist = exist + 1
!                       judge to split this
                     call cjudgesplit(inciptcl, x,  split)
                     if( .not. split ) cycle   

                     call csplitmeson(pstore(i), e1, e2, icon)
                     if(icon == 0) then
                        modified = .true.
                     ! split;  if impossilbe, do nothing
                        nw = nw + 1
                        work(nw) = pstore(i)
                        work(nw).fm.p(4) = e1 + work(nw).mass 
                        call cae2p(work(nw)) ! adjust momentum
                        nw = nw + 1
                        work(nw) = pstore(i)
                        work(nw).fm.p(4) = e2 + work(nw).mass 
                        call cae2p(work(nw))
!                       original one is replaced by E1
                        pstore(i) = work(1)
!                       others are appended to  pstore. 
                        do j = 2, nw ! altough always nw=2
                           nc = nc + 1
                           pstore(nc) = work(j)
                        enddo
                     endif
                  endif
               endif
            endif
         elseif( mode == 1 ) then
            if( i /= maxi ) then
!               discard all pi/K/eta with x>xth (except leanding)
               if(pstore(i).code == kpion .or. pstore(i).code == kkaon 
     *              .or.   pstore(i).code ==  keta ) then
                  if( x > xth ) then
!                   to neglect, put mass as E
                     pstore(i).fm.p(4) = pstore(i).mass
                     pstore(i).fm.p(1:3) = 0.
                     modified = .true.
                  endif
               endif
            endif
         elseif( mode == 2 ) then 
            if( i /= maxi) then
!              discard only pi0/eta
               if( ( pstore(i).code == kpion .and.
     *              pstore(i).charge  == 0 ) .or.
     *              pstore(i).code == keta ) then
                  if(x> xth) then
                     pstore(i).fm.p(4) = pstore(i).mass
                     pstore(i).fm.p(1:3) = 0.    ! put zero energy
                     modified = .true.
                  endif
               endif
            endif
         elseif( mode == 0 ) then
!               do nothing
         else
            write(0,*) ' mode err=',mode, ' in csoftenPiK0'
            stop
         endif
      enddo
      if(abs(mode) == 3) then
         nout = nc
      endif

Here is the call graph for this function:

Here is the caller graph for this function:

csoftenpik1()

subroutine csoftenpik1	(	type(ptcl)	inciptcl,
		type(ptcl), dimension(*)	pstore,
		integer, intent(in)	nin,
		integer, intent(out)	nout,
		integer, intent(out)	exist
	)

Definition at line 332 of file csoftenPiK.f.

References cae2p(), cgetmaxptcl(), charge, code, crejk1(), csplitmeson(), e0lab, e0th, k1u, keta, kkaon, kpion, leadingpik, mass, mode, modified, p, rndc(), true, xth, xthl, and xthu.

Referenced by csoftenpik().

!         inciptcl made a collision and generated nin particles in pstore
!         particle.  information may be at CMS or Lab.
!     If we want to  make the x-dist. softer,
!      A) For Cosmos (air target),  we may use the Lab system
!         (for large X, the distribution would be the same 
!           as CMS)
      implicit none
#include  "Zcode.h"
#include  "Zptcl.h"

      type(ptcl):: inciptcl  ! input. incident ptcl at collision
!                  
      integer,intent(in)::nin ! # of ptcls in pstore 
      type(ptcl):: pstore(*)  ! input/output.   ptcls to be softened.
                           !     Softened ones are put here
      integer,intent(out)::nout ! # of ptcls re-stored in pstore 
      integer,intent(out)::exist  ! # of particcls with X> Xth
! ----------------------------------------------
      type(ptcl):: work(2)
      logical  ok
      integer::maxi
      real(8)::maxe
      integer::i, j 
      real(8):: x, e0, ex, u, u1, u2     
      real(8):: e1, e2
      real(8)::temp
      integer:: nc  ! counting # of ptcls in pstore
      integer:: nw, icon
      logical:: split 

      real(8):: xcent, centval
      xcent = sqrt(xth/xthu*xth*xthl)
      centval =  crejk1(xcent)


      e0 = inciptcl.fm.p(4) - inciptcl.mass
      nout = nin
      exist = 0
      if( e0lab < e0th) return      !!!!!
      nc = nin
!            if pi/K is incident, regards the highest one as leading
!            and avoid to modify 
      if(leadingpik .and. (inciptcl.code == kpion .or.
     *     inciptcl.code == kkaon ) ) then
!              find max energy ptcl index and E; eta cannot be incident
         call cgetmaxptcl(pstore, nc, inciptcl.code, inciptcl.charge,
     *        maxi, maxe)
      else
         maxi = 0
      endif

      do i = 1, nin
         x = (pstore(i).fm.p(4)-pstore(i).mass)/e0
         if( x > xth*xthl ) cycle
         if( abs(mode) == 3 ) then
            if( i /= maxi ) then
!                softening
               if(x > xth/xthu) then
!                  modify high X of pi/K/eta
                  if(pstore(i).code == kpion .or.
     *                 pstore(i).code == kkaon 
     *                 .or.   pstore(i).code ==  keta ) then
                     nw = 0
                     exist = exist + 1
!                       judge to split this
!!                     call cJudgeSplit(inciptcl, x,  split)
                     call rndc(u)
                     temp = crejk1(x)
!                     split = u < 0.25*(temp/centval)
!                     split = u < 0.125*(temp/centval)
                     split = u < k1u*(temp/centval)
                     if( .not. split ) cycle   

                     call csplitmeson(pstore(i), e1, e2, icon)
                     if(icon == 0) then
                        modified = .true.
                     ! split;  if impossilbe, do nothing
                        nw = nw + 1
                        work(nw) = pstore(i)
                        work(nw).fm.p(4) = e1 + work(nw).mass 
                        call cae2p(work(nw)) ! adjust momentum
                        nw = nw + 1
                        work(nw) = pstore(i)
                        work(nw).fm.p(4) = e2 + work(nw).mass 
                        call cae2p(work(nw))
!                       original one is replaced by E1
                        pstore(i) = work(1)
!                       others are appended to  pstore. 
                        do j = 2, nw ! altough always nw=2
                           nc = nc + 1
                           pstore(nc) = work(j)
                        enddo
                     endif
                  endif
               endif
            endif
         elseif( mode == 1 ) then
            if( i /= maxi ) then
!               discard all pi/K/eta with x>xth (except leanding)
               if(pstore(i).code == kpion .or. pstore(i).code == kkaon 
     *              .or.   pstore(i).code ==  keta ) then
                  if( x > xth ) then
!                   to neglect, put mass as E
                     pstore(i).fm.p(4) = pstore(i).mass
                     pstore(i).fm.p(1:3) = 0.
                     modified = .true.
                  endif
               endif
            endif
         elseif( mode == 2 ) then 
            if( i /= maxi) then
!              discard only pi0/eta
               if( ( pstore(i).code == kpion .and.
     *              pstore(i).charge  == 0 ) .or.
     *              pstore(i).code == keta ) then
                  if(x> xth) then
                     pstore(i).fm.p(4) = pstore(i).mass
                     pstore(i).fm.p(1:3) = 0.    ! put zero energy
                     modified = .true.
                  endif
               endif
            endif
         elseif( mode == 0 ) then
!               do nothing
         else
            write(0,*) ' mode err=',mode, ' in csoftenPiK0'
            stop
         endif
      enddo
      if(abs(mode) == 3) then
         nout = nc
      endif

Here is the call graph for this function:

Here is the caller graph for this function:

csplitmeson()

subroutine csplitmeson	(	type(ptcl)	p,
		real(8), intent(out)	E1,
		real(8), intent(out)	E2,
		integer, intent(out)	icon
	)

Definition at line 467 of file csoftenPiK.f.

References false, mass, rndc(), true, and xth.

Referenced by csoftenpik0(), and csoftenpik1().

      implicit none
#include  "Zcode.h"
#include  "Zptcl.h"
      type(ptcl):: p   ! input, a high energy ptcl
      real(8),intent(out):: e1  ! split ptcl energy KE
      real(8),intent(out):: e2  ! split ptcl
      integer,intent(out):: icon ! 0--> split ok, 1--> no split
      real(8):: u,  emin, em
      logical ok
      integer::count

      ok = .false.

      count = 0
      do while(.not. ok)
         call rndc(u)
         u = u*(1.-xth) + xth
         e1 = u*( p.fm.p(4) - p.mass)
         e2 = (p.fm.p(4) -p.mass) - e1
!         if(E1 > p.mass .and.
!     *      E2 > p.mass ) then
            ok = .true.
!         else
!            count = count + 1
!            if(count > 20) then
!               icon = 1
!               return
!            endif
!         endif
      enddo
      icon = 0

Here is the call graph for this function:

Here is the caller graph for this function:

cwriteparac()

subroutine cwriteparac	(	integer	io,
		character*(*)	vname,
		character*(*)	cha
	)

Definition at line 769 of file csoftenPiK.f.

      implicit none
      integer io
      character*(*) vname
      character*(*) cha
      integer klena
      character*2 qmk/" '"/             ! ' 
      if(klena(cha) .gt. 0) then
         write(io,  *) ' ', vname, qmk, cha(1:klena(cha)),
     *        qmk,' /'
      else
         write(io, *) ' ', vname, qmk, ' ', qmk, ' /'
      endif

cwriteparacx()

subroutine cwriteparacx	(	integer	io,
		character*(*)	vname,
		complex*8	c
	)

Definition at line 752 of file csoftenPiK.f.

      implicit none
      integer io
      character*(*) vname
      complex*8  c
      write(io,  *) ' ', vname,' ', c,' /'

cwriteparai()

subroutine cwriteparai	(	integer	io,
		character*(*)	vname,
		integer	i
	)

Definition at line 760 of file csoftenPiK.f.

      implicit none
      integer io
      character*(*) vname
      integer i
      
      write(io,  *) ' ', vname,' ', i,' /'

cwriteparal()

subroutine cwriteparal	(	integer	io,
		character*(*)	vname,
		logical	logi
	)

Definition at line 783 of file csoftenPiK.f.

      implicit none
      integer io
      character*(*) vname
      logical  logi

      write(io,  *) ' ', vname,' ', logi,' /'

cwriteparar()

subroutine cwriteparar	(	integer	io,
		character*(*)	vname,
		real*8	x
	)

Definition at line 734 of file csoftenPiK.f.

      implicit none
      integer io
      character*(*) vname
      real*8  x
      
      write(io, *) ' ', vname,' ', x,' /'

cwriteparar2()

subroutine cwriteparar2	(	integer	io,
		character*(*)	vname,
		real*8, dimension(n)	x,
		integer	n
	)

Definition at line 742 of file csoftenPiK.f.

      implicit none
      integer io
      integer n  ! arra size of x
      character*(*) vname
      real*8  x(n)
      
      write(io,*) ' ', vname,' ', x,' /'

cwritesoftenpara()

subroutine cwritesoftenpara

(

integer, intent(in)

io

)

Definition at line 657 of file csoftenPiK.f.

References cwriteparai(), cwriteparal(), cwriteparar(), e0th, fwbw, k1u, leadingpik, mode, pw, rejpw, repeat, special, usexincms, xth, xthl, and xthu.

       implicit none
       integer,intent(in):: io

       write(io,*)'----------------------'
       call cwriteparai(io,'mode', mode)
       call cwriteparar(io,'xth', xth)
       call cwriteparar(io,'E0th', e0th)
       call cwriteparai(io,'fwbw', fwbw)
       call cwriteparar(io,'pw', pw)
       call cwriteparar(io,'repeat',repeat)
       call cwriteparal(io,'special',special)
       call cwriteparal(io,'leadingPiK',leadingpik)
       call cwriteparal(io,'useXinCMS', usexincms)
       call cwriteparar(io,'k1u', k1u)
       call cwriteparar(io,'xthl', xthl)
       call cwriteparar(io,'xthu', xthu)
       call cwriteparar(io,'rejpw', rejpw)

Here is the call graph for this function:

cxthu()

real(8) function softenpik::cxthu

(

real(8), intent(in)

E0

)

Definition at line 799 of file csoftenPiK.f.

Referenced by csoftenpik().

      implicit none
      real(8),intent(in):: e0 ! lab E0 in Gev
      real(8):: ans   ! xthu
      ans = 12.0*(e0/1.e8)**0.1

Here is the caller graph for this function:

Variable Documentation

e0lab

real(8), save e0lab =1.e12

Definition at line 103 of file csoftenPiK.f.

Referenced by csoftenpik(), csoftenpik0(), csoftenpik1(), and cutptcl().

      real(8),save:: e0lab=1.e12   ! not input. current E0 in lab. 

e0th

real(8), save e0th = 500.

Definition at line 46 of file csoftenPiK.f.

Referenced by creadsoftenpara(), csoftenpik0(), csoftenpik1(), and cwritesoftenpara().

      real(8),save:: e0th = 500.   !  500 GeV  over this we apply cut/mod.

fwbw

integer save fwbw = 3

Definition at line 50 of file csoftenPiK.f.

Referenced by __gencol.f__(), creadsoftenpara(), and cwritesoftenpara().

      integer,save:: fwbw = 3    ! Used in Gencol; modification is applied to

half

integer parameter half =12000

Definition at line 108 of file csoftenPiK.f.

Referenced by minuit(), mnamin(), mncalf(), mncler(), mncntr(), mncomd(), mncont(), mncros(), mncuve(), mnderi(), mndxdi(), mnemat(), mnerrs(), mneval(), mnexcm(), mnexin(), mnfixp(), mnfree(), mngrad(), mnhes1(), mnhess(), mnimpr(), mninex(), mninit(), mninpu(), mnintr(), mnlims(), mnline(), mnmatu(), mnmigr(), mnmnos(), mnmnot(), mnparm(), mnpars(), mnpint(), mnpout(), mnprin(), mnpsdf(), mnrazz(), mnread(), mnrset(), mnsave(), mnscan(), mnseek(), mnset(), mnseti(), mnsimp(), mnstat(), mnstin(), mnvers(), mnvert(), mnwarn(), and mnwerr().

      integer,parameter::half=12000  

k1u

real(8), save k1u =0.25

Definition at line 98 of file csoftenPiK.f.

Referenced by creadsoftenpara(), csoftenpik(), csoftenpik1(), and cwritesoftenpara().

      real(8),save:: k1u=0.25    !   

leadingpik

logical save leadingpik =.true.

Definition at line 81 of file csoftenPiK.f.

Referenced by creadsoftenpara(), csoftenpik0(), csoftenpik1(), and cwritesoftenpara().

      logical,save:: leadingpik=.true.  ! for Pi/K incident case,

mode

integer save mode = 3

Definition at line 34 of file csoftenPiK.f.

Referenced by cjudgesplit(), creadsoftenpara(), csoftenpik0(), csoftenpik1(), and cwritesoftenpara().

      integer,save:: mode = 3      

modified

logical save modified

Definition at line 102 of file csoftenPiK.f.

Referenced by csoftenpik0(), csoftenpik1(), and cutptcl().

      logical,save:: modified   ! not input. used in Cosmos

pw

real(8), save pw = 0.5

Definition at line 36 of file csoftenPiK.f.

Referenced by cjudgesplit(), creadsoftenpara(), cwritesoftenpara(), fitlat0(), and latfnc().

      real(8),save:: pw = 0.5 ! softening is determined by

rejpw

real(8), save rejpw =0.

Definition at line 101 of file csoftenPiK.f.

Referenced by creadsoftenpara(), crejk1(), and cwritesoftenpara().

      real(8),save:: rejpw=0.

repeat

real(8), save repeat = 2.5

Definition at line 40 of file csoftenPiK.f.

Referenced by creadsoftenpara(), csoftenpik(), and cwritesoftenpara().

      real(8),save:: repeat = 2.5  ! apply the simple softenning repeat times

special

logical save special =.false.

Definition at line 55 of file csoftenPiK.f.

Referenced by creadsoftenpara(), cutptcl(), and cwritesoftenpara().

      logical,save:: special=.false.  ! This is used olny in modifyX of

usexincms

logical save usexincms =.false.

Definition at line 90 of file csoftenPiK.f.

Referenced by creadsoftenpara(), cutptcl(), and cwritesoftenpara().

      logical,save:: usexincms=.false.  !This is used only in Cosmos.

xth

real(8), save xth = 0.05

Definition at line 35 of file csoftenPiK.f.

Referenced by cjudgesplit(), creadsoftenpara(), crejk1(), csoftenpik(), csoftenpik0(), csoftenpik1(), csplitmeson(), and cwritesoftenpara().

      real(8),save:: xth = 0.05    ! over this x, we apply cut  or modification

xthl

real(8), save xthl =1.d0

Definition at line 99 of file csoftenPiK.f.

Referenced by creadsoftenpara(), crejk1(), csoftenpik1(), and cwritesoftenpara().

      real(8),save:: xthl=1.d0

xthu

real(8), save xthu =10.d0

Definition at line 100 of file csoftenPiK.f.

Referenced by creadsoftenpara(), crejk1(), csoftenpik(), csoftenpik1(), and cwritesoftenpara().

      real(8),save:: xthu=10.d0