cgpHad.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	cgphad (massN, atomicN, pj, a, ntp)
subroutine	cgplowexp (pj, massN, atomicN, a, ntp)
subroutine	cghcolltype (pj, jtype)
subroutine	cg1pi0 (pj, ic, a, ntp)
subroutine	cg1pic (pj, ic, a, ntp)
subroutine	cg2pi (ic, a, ntp)
subroutine	cg3pi (ic, a, ntp)
subroutine	cfakegh (pj, massN, atomicN, a, ntp)
subroutine	cmkvectormeson (pj, vm, jcon)
subroutine	cvecmesonaftercol (vm, a, nin, nout)
subroutine	cleadingpiaftercol (pix, a, ntp)
subroutine	cfixvectormeson (e, vm, icon)
subroutine	cvmdcy (vm, a, np)

Function/Subroutine Documentation

cfakegh()

subroutine cfakegh	(	type(ptcl)	pj,
		integer, intent(in)	massN,
		integer, intent(in)	atomicN,
		type(ptcl), dimension(*)	a,
		integer, intent(out)	ntp
	)

Definition at line 374 of file cgpHad.f.

References cadjm(), chacol(), cinelx(), cleadingpiaftercol(), cmkptc(), cmkvectormeson(), cvecmesonaftercol(), kpion, and rndc().

Referenced by cgphad(), and cgplowexp().

       use modxsecmedia
       implicit none
#include  "Zcode.h"
#include  "Zptcl.h"
#include  "Zevhnv.h"
#include  "Zair.h"


       type(ptcl):: pj   ! input. photon
       integer,intent(in):: massn ! target  A
       integer,intent(in):: atomicn ! target Z
       type(ptcl):: a(*)  ! produced ptcls
       integer,intent(out)::ntp  ! # of ptcls produced

!
       type(ptcl):: vm
       integer jcon

       real(8)::u
       real(8)::xs
       integer nout
       integer::pichg
       type(ptcl):: pix

!           make pi+ or -    
       call rndc(u)
       
       pix = pj  

       if(activemdl == "qgsjet2") then
          pichg = 0
          call cmkptc(kpion, 0, 0, pix)  ! can accept pi0
          call cadjm(pix, pix)  ! adjust momenutm
          call cxsecqgs(pix, massn,   xs )  ! not for xs 
          call chacol(pix, massn, atomicn, a, ntp)
       elseif( activemdl == "epos") then
          call chacol(pj, massn, atomicn, a, ntp)
       elseif (activemdl /= "ad-hoc" ) then
          if(u < 0.5 ) then
             pichg = -1
          else
             pichg = 1
          endif
          call cmkptc(kpion, 0, pichg, pix)
          call cadjm(pix, pix)
!             some model(JAM) needs xs. for safety get xs 
          call cinelx(pix, massn, atomicn, xs)
          targetxs = xs
          call chacol(pix, massn, atomicn, a, ntp)
          call cleadingpiaftercol(pix, a, ntp)
       else
          call cmkvectormeson(pj, vm, jcon)
          if(jcon /= 0) then
             write(0,*) "cmkVectorMeson failed"
             ntp=1
             a(1) = pj
          else
             call chacol(vm, massn, atomicn, a, ntp)
             call cvecmesonaftercol(vm, a, ntp, nout)
             ntp = nout
          endif
       endif
       

Here is the call graph for this function:

Here is the caller graph for this function:

cfixvectormeson()

subroutine cfixvectormeson	(	real*8	e,
		type(ptcl)	vm,
		integer	icon
	)

Definition at line 532 of file cgpHad.f.

References cmkptc(), komega, kphi, krho, ksbwig(), rndc(), true, womega, wphai, and wrho.

Referenced by cmkvectormeson().

!      *****************************************
       implicit none

#include  "Zptcl.h"
#include  "Zcode.h"
#include  "Zmass.h"
       real*8 e
       type(ptcl):: vm
       integer icon
!       
       integer nc
       real*8 u, amass, w
!
       nc=0
!         *** until loop*** 
       do while (.true.)
          nc=nc+1
          call rndc(u)
          if(u .lt. .46) then
             call cmkptc(krho, 0, 0, vm)
             w=wrho
          elseif(u .lt. .92) then
             call cmkptc(komega, 0, 0, vm)
             w=womega
          else
             call cmkptc(kphi, 0, 0, vm)
             w=wphai
          endif
!              *** until loop*** 
          do while (.true.)
             call ksbwig(vm%mass, w, amass)
             if (amass .gt. vm%mass-w .and. amass .lt. vm%mass+w)
     *                           goto 10
          enddo
 10       continue
          if(e .le. amass) then
             icon=1
          else
             icon=0
          endif
          if  (icon .eq. 0 .or. nc .gt. 10)
     *                      goto 100
       enddo
       vm%mass = amass
 100   continue
       

Here is the call graph for this function:

Here is the caller graph for this function:

cg1pi0()

subroutine cg1pi0	(	type(ptcl)	pj,
		integer	ic,
		type(ptcl), dimension(*)	a,
		integer	ntp
	)

Definition at line 250 of file cgpHad.f.

References c2bdcp(), cmkptc(), cspiangofpin(), knuc, kpion, masp, and regptcl.

Referenced by cgplowexp().

       implicit none
#include  "Zptcl.h"
#include  "Zmass.h"
#include  "Zcode.h"
#include  "Zevhnv.h"

       type(ptcl):: pj, a(*)
       integer ic, ntp
!

        real*8 cs, tmass
        type(ptcl):: eres
        save
!
        tmass=masp
!                   gp-->p+pi0 or gn-->n+pi0; sample cos of pi0 in cms
        call cspiangofpin(cmsp%mass, 1, 0, cs)
!          resonance energy in trs
        eres%fm%p(1) = 0.
        eres%fm%p(2) = 0.
        eres%fm%p(4) = pj%fm%p(4) + tmass
        eres%mass = cmsp%mass
        eres%fm%p(3) = sqrt(eres%fm%p(4)**2 - eres%mass**2)
        call cmkptc(kpion, 0, 0, a(1))        
        call cmkptc(knuc, regptcl, ic, a(2))
        call c2bdcp(eres, a(1), cs, a(2))
!        call c2bdcp(Cmsp,  a(1), cs, a(2))
        ntp=2

Here is the call graph for this function:

Here is the caller graph for this function:

cg1pic()

subroutine cg1pic	(	type(ptcl)	pj,
		integer	ic,
		type(ptcl), dimension(*)	a,
		integer	ntp
	)

Definition at line 281 of file cgpHad.f.

References c2bdcp(), cmkptc(), cspiangofpin(), knuc, kpion, masp, and regptcl.

Referenced by cgplowexp().

       implicit none
#include  "Zptcl.h"
#include  "Zmass.h"
#include  "Zcode.h"
#include  "Zevhnv.h"

       type(ptcl):: pj, a(*)
       integer ic, ntp
!


        real*8 cs, tmass
        type(ptcl):: eres
        save

!       **************
!                   gp-->n+pi+ or gn-->p+pi-; sample cos of pi in cms
        tmass = masp
        call cspiangofpin(cmsp%mass, 0, 1, cs)
        eres%fm%p(4)=pj%fm%p(4) + tmass
        eres%mass = cmsp%mass
        eres%fm%p(3) = sqrt(eres%fm%p(4)**2 - eres%mass**2)
        call cmkptc(kpion, 0, ic, a(1))
        call cmkptc(knuc, regptcl, (1-ic)/2, a(2))
        call c2bdcp(eres, a(1), cs, a(2))
!        call c2bdcp(Cmsp, a(1), cs, a(2))
        ntp=2

Here is the call graph for this function:

Here is the caller graph for this function:

cg2pi()

subroutine cg2pi	(	integer	ic,
		type(ptcl), dimension(*)	a,
		integer	ntp
	)

Definition at line 311 of file cgpHad.f.

References cmkptc(), cnbdcy(), knuc, kpion, and regptcl.

Referenced by cgplowexp().

!       **************
!          particles are produced in cms.
       implicit none
#include  "Zptcl.h"
#include  "Zcode.h"
#include  "Zevhnv.h"

       type(ptcl):: a(*)

       integer ic, ntp

        real*8 w
        integer icon
!                   gp-->p pi+ pi- or gn --> n pi+ pi-
       
       call cmkptc(knuc, regptcl, ic, a(1))
       call cmkptc(kpion, 0, 1, a(2))
       call cmkptc(kpion, 0, -1, a(3))

       call cnbdcy(3, cmsp%mass, a,  0, w, icon)
       if(icon .eq. 1) then
          write(0, *)
     *    ' cnbdcy fails in gp-->p pi+ pi- ', 
     *    ' roots=',cmsp%mass, ' icon=',icon
          ntp=0
       else
          ntp=3
       endif

Here is the call graph for this function:

Here is the caller graph for this function:

cg3pi()

subroutine cg3pi	(	integer	ic,
		type(ptcl), dimension(*)	a,
		integer	ntp
	)

Definition at line 342 of file cgpHad.f.

References cmkptc(), cnbdcy(), knuc, kpion, and regptcl.

Referenced by cgplowexp().

       implicit none
#include  "Zptcl.h"
#include  "Zmass.h"
#include  "Zcode.h"
#include  "Zevhnv.h"

       type(ptcl):: a(*)
       integer ic, ntp, icon
       real*8 w
!
!       **************
!                   gp-->p pi+ pi- pi0 or gn-> 3pi
!            in cms.
       call cmkptc(knuc, regptcl, ic, a(1))
       call cmkptc(kpion, 0, -1, a(2))
       call cmkptc(kpion, 0, 0, a(3))
       call cmkptc(kpion, 0, 1, a(4))
       call cnbdcy(4, cmsp%mass, a,  0, w, icon)
       if(icon .eq. 1) then
           write(0,*) ' cnbdcy fails in gp--> p + 3pi ',
     *     ' roots=',  cmsp%mass, ' icon=',icon
           ntp=0
       else
!          icon =2 comes here. no problem statistically.
!            few percent cases for mass=1.6 to 3 GeV happens to be icon=2
!            (icon = 2 means rejection after 20 trials due to wight problem)
          ntp=4
       endif

Here is the call graph for this function:

Here is the caller graph for this function:

cghcolltype()

subroutine cghcolltype	(	type(ptcl)	pj,
		integer	jtype
	)

Definition at line 201 of file cgpHad.f.

References cgppi0(), cgpxs1(), d0, and rndc().

Referenced by cgplowexp().

      implicit none
#include  "Zptcl.h"
       type(ptcl):: pj
       integer jtype

       real*8 egl, xs1, xs2, xs3, xs4, xso, xst, u
       real*8 xs
       if(pj%fm%p(4) .lt. 5.) then ! actually come here when < 2.5 GeV
!             log10(Eg/MeV); xs in micro barn
          egl=log10(pj%fm%p(4)) + 3
          call cgppi0(egl, xs1)
          call cgppip(egl, xs2)
          call cgppi2(egl, xs3)
          call cgppi3(egl, xs4)
       else
          xs1=0.
          xs2=0.
          xs3=0.
          xs4=0.
       endif
!            gp total x-section  xs in mb
       call cgpxs1(pj%fm%p(4),   xs)
       xs=xs*1000.              ! in micro barn
       xso=max(0.d0, xs-(xs1+xs2+xs3+xs4) ) ! other channel
       if(pj%fm%p(4) .lt. 2.5) xso=0.
       xst=xs1+xs2+xs3+xs4+xso
       if(xst .gt. 0.) then
          call rndc(u)
          if(u .lt. xs1/xst) then
!              gp-->p+pi0 or gn-->n+pi0
             jtype=1
          elseif(u .lt. (xs1+xs2)/xst) then
!                   gp-->n+pi+ or gn-->p+pi-
             jtype=2
          elseif(u .lt. (xs1+xs2+xs3)/xst) then
!                   gp-->p pi+ pi- or gn --> n pi+ pi-
             jtype=3
          elseif( u .lt.  (xs1+xs2+xs3+xs4)/xst) then
             jtype=4
          else
!                  vector meson collision
             jtype=5
          endif
       else
          jtype=0
       endif

Here is the call graph for this function:

Here is the caller graph for this function:

cgphad()

subroutine cgphad	(	integer	massN,
		integer	atomicN,
		type(ptcl)	pj,
		type(ptcl), dimension(*)	a,
		integer	ntp
	)

Definition at line 75 of file cgpHad.f.

References cfakegh(), and cgplowexp().

Referenced by cphotop().

        implicit none
#include  "Zptcl.h"
#include  "Zevhnp.h"
#include  "Zevhnv.h"
#include  "Zmass.h"
#include  "Zcode.h"

        integer ntp, icin
        type(ptcl):: pj,  a(*)
        integer  massn, atomicn

        if( pj%fm%p(4) < 2.5 ) then
           call cgplowexp(pj, massn, atomicn,  a, ntp)
        else
           call cfakegh(pj, massn, atomicn,  a, ntp)
        endif

Here is the call graph for this function:

Here is the caller graph for this function:

cgplowexp()

subroutine cgplowexp	(	type(ptcl)	pj,
		integer, intent(in)	massN,
		integer, intent(in)	atomicN,
		type(ptcl), dimension(*)	a,
		integer, intent(out)	ntp
	)

Definition at line 95 of file cgpHad.f.

References cbst1(), cfakegh(), cfxtgtchg(), cg1pi0(), cg1pic(), cg2pi(), cg3pi(), cgeqm(), cghcolltype(), cibst1(), cmkptc(), csampfermim(), knuc, and regptcl.

Referenced by cgphad().

!          basically Eg < 2.5 GeV.  use exp. data
      implicit none
#include  "Zptcl.h"
#include  "Zevhnp.h"
#include  "Zevhnv.h"
#include  "Zmass.h"
#include  "Zcode.h"
      type(ptcl):: pj          ! input projectile photon
      integer,intent(in):: massn ! target A
      integer,intent(in):: atomicn ! target Z


      integer,intent(out):: ntp ! # of ptcls produced
      type(ptcl):: a(*)        ! output produced particles


      type(ptcl)::pic

      integer ic                ! target N charge
      logical fermim
      type(ptcl):: tgt
      type(ptcl)::  pjx
      integer icon
      integer jtype
      integer k

      if( massn >= 2 ) then
!           fix target charge (n or p)
         call cfxtgtchg(massn, atomicn, ic)
      else
         ic=atomicn
      endif
!          make target
      call cmkptc(knuc, regptcl, ic, tgt)
      fermim=(pj%fm%p(4) -pj%mass) .lt. efermi
     *          .and. massn >= 2
      if(fermim) then
         call csampfermim(tgt%fm) ! 4 mom. has been  set
!              boost the projectile into target
!              rest system (trs).
         call cbst1(1, tgt, pj,  pjx)
      else
         pjx = pj
!            rest target
         tgt%fm%p(1) = 0.
         tgt%fm%p(2) = 0.
         tgt%fm%p(3) = 0.
         tgt%fm%p(4) = tgt%mass
      endif
!             make cm ptcl
      call  cgeqm(pj, tgt, cmsp, icon) ! not pjx
      if(icon /= 0  ) then
         write(0,*) ' cms cannot be formed in cgpLowExp'
         stop
      endif
!            fix collision type
      call cghcolltype(pjx, jtype)
      if(jtype .eq. 0) then     ! will not happen
         ntp=1                  !   older version  0 and no product
         a(1)=pj                ! gamma 
      elseif(jtype .eq. 1) then
!           gp-->p+pi0 or gn-->n+pi0
!           'a' gets particles at target rest system
         call cg1pi0(pjx, ic, a, ntp)
      elseif(jtype. eq. 2) then
!           gp-->n+pi+ or gn-->p+pi-;  at target rest system
         call cg1pic(pjx, ic,  a, ntp)
      elseif(jtype .eq. 3) then
!           gp-->p pi+ pi- or gn --> n pi+ pi- at  CMS
         call cg2pi(ic,  a, ntp) 
      elseif(jtype .eq. 4) then
!                'a' gets CMS ptcls
         call cg3pi(ic, a, ntp)
      elseif(jtype .eq. 5) then ! will not come in our setting
!               vector meson type.  ptcls produced  in lab.
         call cfakegh(pj, massn, atomicn, a, ntp)
      else
         write(0,*) ' strage jtype=',jtype, ' from cghCollType'
      endif
      if(fermim .and. jtype .le. 2) then
!            boost ptcls back to lab. 
         do   k=1, ntp
            call cibst1(k, tgt, a(k), a(k))
         enddo
      elseif(jtype .eq.  3 .or. jtype .eq. 4) then
!              now in cms. boost to lab
         do k =1, ntp
            call cibst1(k, cmsp, a(k), a(k))
         enddo
      else
!          jtype =1 or 2 and fermin=F; then a is already in lab.
      endif

Here is the call graph for this function:

Here is the caller graph for this function:

cleadingpiaftercol()

subroutine cleadingpiaftercol	(	type(ptcl)	pix,
		type(ptcl), dimension(ntp)	a,
		integer, intent(in)	ntp
	)

Definition at line 499 of file cgpHad.f.

References cadjm(), cmkptc(), and kpion.

Referenced by cfakegh().

      implicit none
!         replace max energy pi with same type of pix
!      by pi0
#include  "Zptcl.h"
#include  "Zevhnp.h"
#include  "Zevhnv.h"
#include  "Zmass.h"
#include  "Zcode.h"
      type(ptcl):: pix
      integer,intent(in):: ntp
      type(ptcl):: a(ntp)
      
      integer i, maxi
      real(8)::maxe
      maxe=-1.0
      maxi =0
      do i = 1, ntp
         if( pix%code == a(i)%code ) then
            if( pix%charge == a(i)%charge ) then
               if(maxe < a(i)%fm%p(4)) then
                  maxe = a(i)%fm%p(4)
                  maxi = i
               endif
            endif
         endif
      enddo
      if( maxi > 0 ) then
         call cmkptc(kpion, 0, 0, a(maxi))
         call cadjm(a(maxi),a(maxi))
      endif

Here is the call graph for this function:

Here is the caller graph for this function:

cmkvectormeson()

subroutine cmkvectormeson	(	type(ptcl)	pj,
		type(ptcl)	vm,
		integer, intent(out)	jcon
	)

Definition at line 440 of file cgpHad.f.

References cfixvectormeson().

Referenced by cfakegh().

      implicit none
#include  "Zptcl.h"
#include  "Zevhnp.h"
#include  "Zevhnv.h"
#include  "Zmass.h"
#include  "Zcode.h"
      type(ptcl):: pj          ! input. photon
      type(ptcl):: vm          ! output
      integer,intent(out):: jcon !

      real(8):: p, alfa
!         fix vector meson (rho, omega, or phai)
!                              46  46         8 %
      call cfixvectormeson(pj%fm%p(4), vm, jcon)
!     make vector meson proj.
      p=sqrt(pj%fm%p(4)**2 - vm%mass**2)
      alfa=p/pj%fm%p(4)
      vm%fm%p(1) = pj%fm%p(1)*alfa
      vm%fm%p(2) = pj%fm%p(2)*alfa
      vm%fm%p(3) = pj%fm%p(3)*alfa
      vm%fm%p(4) = pj%fm%p(4)

Here is the call graph for this function:

Here is the caller graph for this function:

cvecmesonaftercol()

subroutine cvecmesonaftercol	(	type(ptcl)	vm,
		type(ptcl), dimension(nin)	a,
		integer, intent(in)	nin,
		integer, intent(out)	nout
	)

Definition at line 464 of file cgpHad.f.

References cvmdcy(), and kphoton.

Referenced by cfakegh().

      implicit none
#include  "Zptcl.h"
#include  "Zevhnp.h"
#include  "Zevhnv.h"
#include  "Zmass.h"
#include  "Zcode.h"
      type(ptcl):: vm          ! input. vector meson
      integer,intent(in):: nin  ! # of ptcls in a
      type(ptcl):: a(nin)      ! ptcls generated by col.
      integer,intent(out)::nout ! after vm treatment, # of ptcls in a
      type(ptcl):: b(10)
      integer i, nx, j
      real(8):: p, alfa
      nout  = nin
      do i = 1, nin
         if( a(i)%code == vm%code ) then
#if VECMESDECAY == 1
            call cvmdcy(a(i), b, nx)
            a(i) = b(1)
            do j = 2,  nx
               a(j+nout-1) = b(j)
            enddo
            nout = nout + nx -1
#else
            a(i)%code = kphoton
            a(i)%mass = 0.
            p=a(i)%fm%p(4)
            alfa=sqrt(dot_product( a(i)%fm%p(1:3),a(i)%fm%p(1:3)))
     *         /p
            a(i)%fm%p(1:3) = a(i:3)%fm%p(1)/alfa
#endif
         endif
      enddo

Here is the call graph for this function:

Here is the caller graph for this function:

cvmdcy()

subroutine cvmdcy	(	type(ptcl)	vm,
		type(ptcl), dimension(*)	a,
		integer	np
	)

Definition at line 583 of file cgpHad.f.

References comgdc(), cphidc(), crhodc(), komega, kphi, and krho.

Referenced by cvecmesonaftercol().

       implicit none
#include  "Zptcl.h"
#include  "Zcode.h"
       type(ptcl):: vm, a(*)
       integer np
!
       if(vm%code .eq. krho) then
          call crhodc(vm, a, np)
       elseif(vm%code .eq. komega) then
          call comgdc(vm, a, np)
       elseif(vm%code .eq. kphi) then
          call cphidc(vm, a, np)
       endif

Here is the call graph for this function:

Here is the caller graph for this function: