!  genesis_m.f90
!
!  Module defining basic parameters, data types and constants for the
!  Genesis generator package.
!
!  Detlef Irmscher, Thomas Ullrich, Uni Heidelberg, September 1993
!  Last update: 16.3.95 tu   major revision; now one common module
!                            with all constants and data types. All
!                            module procedures put in seperate files.
!
module genesis_m
    use f90_kind
    use mom_m


    character(len=*), parameter     :: version = "Genesis, Version A.01.00 April 95,  (ported to DECUnix, Nov 97, by R.Holzmann)"

    !
    ! Constants
    !
    real(kind=double), parameter    :: pi = 3.141592653589793238
    real(kind=double), parameter    :: twopi = 2*pi
    integer, parameter              :: error = -1
    
    !
    ! I/O related parameters
    !
    integer, parameter   :: lunRc = 2
    character(len=80)    :: rcFile = 'd.genesisrc'

    !
    ! Global variables
    !
    real                 :: central_rapidity = -1
    real                 :: central_over_total_pion0 = -1
    real                 :: pion0_over_nch = 0.44
    real                 :: etaMin = -10., etaMax= 10.
    integer              :: rndmSeed = 1
    integer              :: is_mass_weight = 0
    integer              :: is_pt_weight = 0
    character(len=240)   :: errmess
    logical              :: isInitialized = .false.
    real                 :: vmass, vwidth

    !
    ! Nucleus data type
    !
    type nucleus
        character(len=30) :: name
        integer           :: A
        integer           :: Z
        type(mom4)        :: p
    end type nucleus

    type(nucleus) :: projectile, target

    !
    ! Particle data type
    !
    integer, parameter :: spinZero = 0        ! spins definitions in 1/2 units
    integer, parameter :: spinHalf = 1
    integer, parameter :: spinOne  = 2

    type particle                             ! data type particle
        integer                 :: id
        character(len=16)       :: name
        real(kind=double)       :: mass
        real(kind=double)       :: width
        integer                 :: charge
        integer                 :: spin
        real                    :: relSigmaTotal
        real                    :: relSigmaCentral
        integer                 :: ptHbookId
        integer                 :: yHbookId
    end type particle

    interface operator (==)
        module procedure  partEQpart
    end interface

    interface operator (/=)
        module procedure  partNEpart
    end interface

    type(particle), pointer     :: particleList(:)

    !
    ! Decay data type
    !
    type decay
        character(len=80)       :: name
        integer                 :: nBody
        real(kind=double)       :: branchingRatio
        integer                 :: formFactor
        type(particle)          :: parent
        type(particle), pointer :: child(:)
        logical                 :: decayChildren
        logical                 :: enabled
        integer                 :: HbookId
    end type decay

    type(decay), pointer        :: decayList(:)

    !
    !  Form Factor model to use
    !
    integer, parameter :: USE_NONE     = 0
    integer, parameter :: USE_VDM      = 1
    integer, parameter :: USE_LEPTON_G = 2
    
    
    !
    ! Tree data type
    !
    integer                     :: maxtree, lasttree

    type tree
        type(particle), pointer :: parttype
        type(decay), pointer    :: decaytype
        integer                 :: parent
        integer                 :: child(3)
        type(mom4)              :: p4
        logical                 :: decayed
        logical                 :: isStable
        real                    :: mass_weight
        real                    :: pt_weight
    end type tree

    type(tree), pointer         :: treeList(:)

    !
    !  Histograms
    !  Lower id for the different histogram classes
    !  >= workingID    histos used for hrndm 
    !  >= originalID   histos kept untouched for later analysis
    !
    integer, parameter :: workingID  = 100     
    integer, parameter :: originalID = 10000

    !
    ! Interfaces
    !
    interface
       subroutine GeInit(resourceFile, verbose)
          logical, optional :: verbose
          character(len=*)  :: resourceFile
       end subroutine GeInit

       subroutine GeTriggerEvent(nch,bpar)
          integer :: nch
          real    :: bpar
       end subroutine GeTriggerEvent

       subroutine GeErrorMessage(routine, message, rc, fatal)
          character(len=*) :: routine , message
          integer, optional :: rc
          logical, optional :: fatal
       end subroutine GeErrorMessage
       
!       real function GeFormFactor(q2, decaytype)
!          use genesis_m, self=>GeFormFactor
!          use f90_kind
!          use decay_m
!          type(decay)                  :: decaytype
!          real(kind=double)            :: q2
!       end function GeFormFactor
       
       function GeGetEta (ipart)
          use f90_kind
 	  integer           :: ipart
          real(kind=double) :: GeGetEta
       end function GeGetEta 

       function GeGetRapidity (ipart,bpar,pt)
          use f90_kind
 	  integer           :: ipart
          real              :: bpar
          real(kind=double) :: pt
          real(kind=double) :: GeGetRapidity
       end function GeGetRapidity
       
       function GeGetPt (ipart, weight)
          use f90_kind
          integer, intent(in)            :: ipart
          real(kind=double), intent(out) :: weight
          real(kind=double)              :: GeGetPt	  
       end function GeGetPt
       
       subroutine GeDalitzDecay (treeIndex)
          integer, intent(in) :: treeIndex
       end subroutine GeDalitzDecay 
       
       integer function GeFreeHbookId(idStart)
          integer, intent(in) :: idStart
       end function GeFreeHbookId
       
       integer function GeAllocTree (parentindex, part_name)
          integer, intent(in)          :: parentindex
          character(len=*), intent(in) :: part_name
       end function  GeAllocTree

       subroutine GeAppendTree 
       end subroutine GeAppendTree
       
       function GeBoost (p_old, p_frame)
          use mom_m
          type(mom4)              :: GeBoost
          type(mom4), intent(in)  :: p_old, p_frame
       end function GeBoost
       
       subroutine GeGetResources 
       end subroutine GeGetResources
       
       subroutine GeCheckResources 
       end subroutine GeCheckResources
       
       subroutine GeShowResources 
       end subroutine GeShowResources
       
       subroutine GeDecayLoop 
       end subroutine GeDecayLoop
       
       subroutine GeInitRndm 
       end subroutine GeInitRndm

       subroutine GeDecay2Body(oldindex)
          integer, intent(in)  :: oldindex
       end subroutine GeDecay2Body
       
       subroutine GeDecay3Body(oldindex)
          integer, intent(in)  :: oldindex
       end subroutine GeDecay3Body

       subroutine  GeFillTree(treeindex, pt, eta, weight)
          use f90_kind
          integer, intent(in)           :: treeindex
          real(kind=double), intent(in) :: pt, eta, weight
       end subroutine GeFillTree

       subroutine GeInitTrigger(nch,bpar)
          integer, intent(in)  :: nch
          real                 :: bpar
       end subroutine GeInitTrigger
       
!       logical function GeIsDalitzDecay(thisDecay)
!	  use genesis_m, self=>GeIsDalitzDecay
!          use decay_m
!	  type(decay)          :: thisDecay
!       end function GeIsDalitzDecay

       subroutine GeLetDecay(currentIndex)
          integer, intent(in)  :: currentIndex
       end subroutine GeLetDecay
       
       function GeP3rot (p3old, costh, sinth, cosph, sinph)
          use f90_kind
          use mom_m
          type(mom3)                     :: GeP3rot
          type (mom3), intent(in)        :: p3old
          real (kind=double), intent(in) :: costh, sinth, cosph, sinph
       end function GeP3rot

       integer function GeNpois(amean)
          use f90_kind
          real(kind=double), intent(in)   :: amean
       end function GeNpois
       
       integer function GePartProd(ipart, nch_over_central_over_total_pi0)
	  integer, intent(in) :: ipart
	  integer, intent(in) :: nch_over_central_over_total_pi0
       end function GePartProd
       
       subroutine GeReallocTree(newup, istat)
	  integer, intent(in)    :: newup
	  integer, intent(out)   :: istat
       end subroutine GeReallocTree
       
       integer function GeParticleIndex(pname)
	  character(len=*), intent(in) :: pname
       end function GeParticleIndex

       subroutine hbook1(id,text,nbins,xlow,xup,words)
          integer, intent(in)          :: id, nbins
	  real, intent(in)             :: xlow,xup,words
	  character(len=*), intent(in) :: text
       end subroutine hbook1

       real function hrndm1(id)
          integer, intent(in) :: id
       end function hrndm1
       
       logical function hexist(id)
          integer, intent(in) :: id
       end function hexist
       
       subroutine hf1(id, x, weight)
          integer, intent(in) :: id
          real, intent(in)    :: x, weight
       end subroutine hf1
       
       subroutine hfill(id, x, y, weight)
          integer, intent(in) :: id
          real, intent(in)    :: x, y, weight
       end subroutine hfill
       
       subroutine hbfun1(id,text,nbins,xlow,xup,fun)
          integer, intent(in)          :: id, nbins
	  real, intent(in)             :: xlow, xup
	  character(len=*), intent(in) :: text
!	  real, external               :: fun
	  interface 
	     real function fun(x)
	        real, intent(in) :: x
	     end function fun
	  end interface
       end subroutine hbfun1
       
       real function hx(id, x)
          integer, intent(in) :: id
          real, intent(in)    :: x
       end function hx
       
       real function hsum(id)
          integer, intent(in) :: id
       end function hsum
       
       subroutine hcopy(id1,id2,text)
          integer, intent(in)          :: id1, id2
	  character(len=*), intent(in) :: text
       end subroutine hcopy       
    end interface

contains

    logical function partEQpart(part1, part2)
        type(particle), intent(in) :: part1, part2
        partEQpart = .false.
        if (part1%id == part2%id .and. &
            part1%name == part2%name .and. &
            part1%mass == part2%mass .and. &
            part1%charge == part2%charge .and. &
            part1%spin == part2%spin ) partEQpart = .true.
    end function partEQpart

    logical function partNEpart(part1, part2)
        type(particle), intent(in) :: part1, part2
        partNEpart = .not. (part1 == part2)
    end function partNEpart

end module genesis_m