module MC_Delta_mod
! Uses
use precision_mod
use namelist_mod
use hists_mod
use unpmc_mod
use hitpos_struct_mod
use pattern_mod
use skim_mod
! Types
public type mc_delta_type
! Variables
integer (kind=I4), public, PARAMETER :: MaxMCDeltas = 300
integer (kind=I4), public :: nMCDeltas
integer (kind=I4), public :: nMCmDeltas
integer (kind=I4), public :: nMCposDeltas
integer (kind=I4), public :: nMCbeamDeltas
integer (kind=I4), public :: nMCeDeltas
type (mc_delta_type), public, DIMENSION(MaxMCDeltas), TARGET :: MCmDelta
type (mc_delta_type), public, DIMENSION(MaxMCDeltas), TARGET :: MCposDelta
type (mc_delta_type), public, DIMENSION(MaxMCDeltas), TARGET :: MCbeamDelta
type (mc_delta_type), public, DIMENSION(MaxMCDeltas), TARGET :: MCeDelta
! Subroutines and functions
public subroutine MCDeltas (UseMCDeltas)
private subroutine CountMCDeltas ()
private function FillMCDelta (DecayFlag, iTrack, Delta)
private function CheckDecay (iMC)
private subroutine DeltaHitStats (iTrack, nHits, MinPl, MaxPl, DHitPos, nHitPos)
private subroutine FillMCDeltaHists ()
private subroutine FillSingleSetHists (nDeltas, Delta, IDH, NDH)
private function CalcTotalPlanes (Delta) result (nTotalPls)
public subroutine MCvsMOFIADeltaHists ()
private subroutine CorrelateDeltas ()
private subroutine CountDeltaHits (RecDelta, nRPCHits, nRDCHits)
private function uvMatch (MCDelta, RecDelta)
private function CalcZDiff (MCDelta, RecDelta)
private recursive subroutine FindBestMatches (zDiff)
end module MC_Delta_mod
==============================================================================
Name: MC_Delta_mod
Creation Date: June 4, 2003
------------------------------------------------------------------------------
Description:
Module contains routines that use standard MC bank in combination with
special MUSR bank to collect data about deltas and fill appropriate
histograms.
Routines are called if ...
Name Global UnpackMC = T
Name FirstGuess RemoveDeltas = T
==============================================================================
Author: Jim Musser
Version: 1.0
public type mc_delta_type
integer (kind=I4) :: iTrack
real (kind=R4), DIMENSION(4) :: Vinitial
real (kind=R4), DIMENSION(4) :: Vfinal
real (kind=R4), DIMENSION(3) :: P
integer (kind=I4) :: MinPCPl
integer (kind=I4) :: MaxPCPl
integer (kind=I4) :: MinDCPl
integer (kind=I4) :: MaxDCPl
integer (kind=I4) :: MinPl
integer (kind=I4) :: MaxPl
integer (kind=I4) :: nPCHits
integer (kind=I4) :: nDCHits
integer (kind=I4) :: iDel
end type mc_delta_type
integer (kind=I4), public, PARAMETER :: MaxMCDeltas = 300
integer (kind=I4), public :: nMCDeltas
integer (kind=I4), public :: nMCmDeltas
integer (kind=I4), public :: nMCposDeltas
integer (kind=I4), public :: nMCbeamDeltas
integer (kind=I4), public :: nMCeDeltas
type (mc_delta_type), public, DIMENSION(MaxMCDeltas), TARGET :: MCmDelta
type (mc_delta_type), public, DIMENSION(MaxMCDeltas), TARGET :: MCposDelta
type (mc_delta_type), public, DIMENSION(MaxMCDeltas), TARGET :: MCbeamDelta
type (mc_delta_type), public, DIMENSION(MaxMCDeltas), TARGET :: MCeDelta
public subroutine MCDeltas (UseMCDeltas)
logical, INTENT(in) :: UseMCDeltas
! Calls: CountMCDeltas, FillMCDeltaHists
end subroutine MCDeltas
----------------------------------------------------------------------------
Entry point and steering routine for module
----------------------------------------------------------------------------
Author: Jim Musser
private subroutine CountMCDeltas ()
! Calls: FillSkim
end subroutine CountMCDeltas
----------------------------------------------------------------------------
Routine produces sums of all deltas in an event and counts by type of
particle that produced the delta. FillMCDelta is called for each delta.
----------------------------------------------------------------------------
Author: Jim Musser
private function FillMCDelta (DecayFlag, iTrack, Delta)
logical, INTENT(in) :: DecayFlag
integer (kind=I4), INTENT(in) :: iTrack
type (mc_delta_type), INTENT(inout) :: Delta
integer (kind=I4) :: FillMCDelta
! Calls: DeltaHitStats
end function FillMCDelta
----------------------------------------------------------------------------
Function fills mc_delta_type structure with detailed information from each
delta.
----------------------------------------------------------------------------
Author: Jim Musser
private function CheckDecay (iMC)
integer, INTENT(in) :: iMC
logical :: CheckDecay
end function CheckDecay
----------------------------------------------------------------------------
Routine checks to see if delta produced by positron is within window of
decay positron.
----------------------------------------------------------------------------
Author: Jim Musser
private subroutine DeltaHitStats (iTrack, nHits, MinPl, MaxPl, DHitPos, nHitPos)
integer (kind=I4), INTENT(in) :: iTrack
integer (kind=I4), INTENT(out) :: nHits
integer (kind=I4), INTENT(out) :: MinPl
integer (kind=I4), INTENT(out) :: MaxPl
type (hitpos_type), DIMENSION(:), INTENT(in) :: DHitPos
integer (kind=I4), INTENT(in) :: nHitPos
end subroutine DeltaHitStats
----------------------------------------------------------------------------
Routine fills delta structure with data derived from hits recorded by
GEANT simulation.
----------------------------------------------------------------------------
Author: Jim Musser
private subroutine FillMCDeltaHists ()
! Calls: FillSingleSetHists, HFF1
end subroutine FillMCDeltaHists
----------------------------------------------------------------------------
Routine calls histogram filling routine for deltas produced by various
particles.
----------------------------------------------------------------------------
Author: Jim Musser
private subroutine FillSingleSetHists (nDeltas, Delta, IDH, NDH)
integer (kind=I4), INTENT(in) :: nDeltas
type (mc_delta_type), DIMENSION(:), INTENT(inout) :: Delta
integer (kind=I4), INTENT(in) :: IDH
integer (kind=I4), DIMENSION(:,:), INTENT(in) :: NDH
! Calls: HFF1, HFF2
end subroutine FillSingleSetHists
----------------------------------------------------------------------------
Routine fills histograms for deltas produced by a single particle type.
----------------------------------------------------------------------------
Author: Jim Musser
private function CalcTotalPlanes (Delta) result (nTotalPls)
type (mc_delta_type), INTENT(inout) :: Delta
integer (kind=I4) :: nTotalPls
end function CalcTotalPlanes
----------------------------------------------------------------------------
Routine finds Minimum, Maximum and Number of planes spanned by MC delta
----------------------------------------------------------------------------
Author: Jim Musser
public subroutine MCvsMOFIADeltaHists ()
! Calls: CorrelateDeltas, CountDeltaHits, FillSkim, HFF1, HFF2
end subroutine MCvsMOFIADeltaHists
----------------------------------------------------------------------------
Routine fills histograms comparing MC bank delta information with
reconstructed delta information
----------------------------------------------------------------------------
Author: Jim Musser
private subroutine CorrelateDeltas ()
! Calls: FindBestMatches
end subroutine CorrelateDeltas
----------------------------------------------------------------------------
Routine associates deltas found by the reconstruction code with deltas
from the MC bank information.
----------------------------------------------------------------------------
Author: Jim Musser
private subroutine CountDeltaHits (RecDelta, nRPCHits, nRDCHits)
type (line_type), INTENT(in), TARGET :: RecDelta
integer (kind=I4), INTENT(out), TARGET :: nRPCHits
integer (kind=I4), INTENT(out), TARGET :: nRDCHits
end subroutine CountDeltaHits
----------------------------------------------------------------------------
Routine counts the total number of hits for a reconstructed delta
----------------------------------------------------------------------------
Author: Jim Musser
private function uvMatch (MCDelta, RecDelta)
type (mc_delta_type), INTENT(in) :: MCDelta
type (line_type), INTENT(in) :: RecDelta
logical :: uvMatch
end function uvMatch
----------------------------------------------------------------------------
Routine determines whether MC bank delta and reconstructed delta have a
common projection onto the u-v plane within the resolution defined by uvRes
----------------------------------------------------------------------------
Author: Jim Musser
private function CalcZDiff (MCDelta, RecDelta)
type (mc_delta_type), INTENT(in) :: MCDelta
type (line_type), INTENT(in) :: RecDelta
real (kind=R4) :: CalcZDiff
end function CalcZDiff
----------------------------------------------------------------------------
Routine calculates measure of difference of endpoints between MC bank
delta and reconstructed delta. Reconstructed deltas are required not to
extend beyond MC delta by zRes.
----------------------------------------------------------------------------
Author: Jim Musser
private recursive subroutine FindBestMatches (zDiff)
real (kind=R4), DIMENSION(:,:), INTENT(inout) :: zDiff
! Calls: FindBestMatches
end subroutine FindBestMatches
----------------------------------------------------------------------------
Routine finds best match between MC bank and reconstructed deltas if
matches are ambiguous.
----------------------------------------------------------------------------
Author: Jim Musser