Module ClassifyBJ_mod

module ClassifyBJ_mod

        ! Uses
    use Precision_mod
    use Chambers_mod
    use Det_Geom_mod, ONLY: max_planes_d,max_wires_d,  max_planes_p, max_wires_p,   npfoils, ndfoils, zpfoil, zdfoil, targ_z
    use tdc_mod
    use unp_mod
    use unpmc_mod
    use Namelist_mod
    use Track_mod
    use Pattern_mod
    use Hists_mod
    use Skim_mod
    use windowstat_mod

        ! Types
    public type MCwin_type

        ! Variables
    integer (kind=i4), public :: MCEventType
    integer (kind=i4), public :: ClasPiEnuWin
    integer (kind=i4), private :: nClasPiEnuWin
    integer (kind=i4), private :: nMCParticles
    integer (kind=i4), public :: nMCDecayPositrons
    integer (kind=i4), private :: nMCMuons
    integer (kind=i4), private :: nMCBeamPositrons
    integer (kind=i4), private, dimension (MaxWindows) :: MCMuArray
    integer (kind=i4), private, dimension (MaxWindows) :: MCMuWindows
    integer (kind=i4), public, dimension (MaxWindows) :: MCDKArray
    integer (kind=i4), public, dimension (MaxWindows) :: MCDKWindows
    integer (kind=i4), private, dimension (MaxWindows) :: MCDecayMuWin
    integer (kind=i4), private :: MCDecayWin
    integer (kind=i4), public, dimension (kMaxMcTracks) :: imcwindows
    integer (kind=i4), private :: nMCDeltas
    integer (kind=i4), private, dimension (kMaxMcTracks) :: Darray
    real (kind=r4), private, dimension (kMaxMcTracks) :: Dstartz
    real (kind=r4), private, dimension (kMaxMcTracks) :: Dstopz
    real (kind=r4), private, dimension (kMaxMcTracks) :: Dtime
    real (kind=r4), private, dimension (kMaxMcTracks) :: DSPminZ
    real (kind=r4), private, dimension (kMaxMcTracks) :: DSPmaxZ
    logical, private, dimension (kMaxMcTracks) :: Dadded
    integer (kind=i4), private :: MCTriggerWin
    integer (kind=i4), public :: nMCwindows
    type (MCwin_type), public, DIMENSION(kMaxMcTracks), TARGET :: MCwin

        ! Subroutines and functions
    public function ClassifyingBJ () result (EventSelected)
    private subroutine LookForPossiblePiEnu ()
    private subroutine FillTDClochists ()
    private subroutine FillTDCloc (igplane, r, x, y, t, PorD, hitspp)
    private subroutine BookTDClochists ()
    private subroutine EvalEventMC ()
    private subroutine getSPextent (imc, minZ, maxZ, turnaround, hiddendelta)
    private subroutine fillSPscatterZ (imc, endscatter)
    private subroutine StartStopZtoGlobalPlane (startz, stopz, startP, stopP)
    private subroutine EvalEventPlanes (EType)
    private subroutine EvalEventPlanesMC (EType)
    private subroutine EvalEvent ()
    private subroutine FillMCEventTypeHist ()
    public function getPCVertex (iwindow, iplane)
    public function getDCVertex (iwindow, iplane)
    public function getGlobalPlaneExitFoilZ (stopplane)
    public function getGlobalPlaneCenterZ (stopplane)
    public subroutine FillWinUVPVertex (inwin, firstp, ipulast, ipvlast, ul, vl)
    public subroutine FillWinDCUVPVertex (inwin, firstp, ipulast, ipvlast, ul, vl)
    public subroutine getpcdcfromglobal (ip, idc, ipc, idirp)

end module ClassifyBJ_mod
 MODULE ClassifyBJ_mod
==============================================================================
 Author: Blair
 Initial Revision: Feb. 2003
 Last Updated:
------------------------------------------------------------------------------
 This module contains subroutines used to classify events from window types
 paritcles.  The main function of this module is to classify events before 
 running time expensive track fitting code (function classifying). 
 (The window types are assigned in the subroutine EvalWindowType (in
 evalwin_mod.f90), which is called from the subroutine AssignToWindows
 (in assigntowindow_mod.f90), which is called from the subroutine
 WindowingBJ (in windowbj_mod.f90).)

Description of Types

MCwin_type

public type MCwin_type
    integer (kind=i4) :: Wtype
    real (kind=r4) :: t0
    real (kind=r4) :: tstart
    real (kind=r4) :: tend
    integer (kind=i4) :: nMuons
    integer (kind=i4) :: nDecays
    integer (kind=i4) :: dkimc
    integer (kind=i4) :: nBeame
    real (kind=r4) :: SPminZ
    real (kind=r4) :: SPmaxZ
    real (kind=r4) :: startz
    real (kind=r4) :: stopz
    integer (kind=i4) :: startp
    integer (kind=i4) :: stopp
    integer (kind=i4) :: nDeltas
    real (kind=r4), dimension (kMaxMcTracks) :: Dstartz
    real (kind=r4), dimension (kMaxMcTracks) :: Dstopz
    integer (kind=i4), dimension (kMaxMcTracks) :: DstartP
    integer (kind=i4), dimension (kMaxMcTracks) :: DstopP
    logical :: Deltaonotherside
    real (kind=r4) :: Dtend
    real (kind=r4), dimension (kMaxMcTracks) :: Dvu
    real (kind=r4), dimension (kMaxMcTracks) :: Dvv
    real (kind=r4), dimension (kMaxMcTracks) :: Dptot
    real (kind=r4), dimension (kMaxMcTracks) :: Dpz
    integer (kind=i4) :: decaydir
    logical :: hardscatter
    logical :: turnaroundhardscatter
    logical :: dtendscatter
end type MCwin_type

Description of Variables

MCEventType

integer (kind=i4), public :: MCEventType

ClasPiEnuWin

integer (kind=i4), public :: ClasPiEnuWin

nClasPiEnuWin

integer (kind=i4), private :: nClasPiEnuWin

nMCParticles

integer (kind=i4), private :: nMCParticles

nMCDecayPositrons

integer (kind=i4), public :: nMCDecayPositrons

nMCMuons

integer (kind=i4), private :: nMCMuons

nMCBeamPositrons

integer (kind=i4), private :: nMCBeamPositrons

MCMuArray

integer (kind=i4), private, dimension (MaxWindows) :: MCMuArray

MCMuWindows

integer (kind=i4), private, dimension (MaxWindows) :: MCMuWindows

MCDKArray

integer (kind=i4), public, dimension (MaxWindows) :: MCDKArray

MCDKWindows

integer (kind=i4), public, dimension (MaxWindows) :: MCDKWindows

MCDecayMuWin

integer (kind=i4), private, dimension (MaxWindows) :: MCDecayMuWin

MCDecayWin

integer (kind=i4), private :: MCDecayWin

imcwindows

integer (kind=i4), public, dimension (kMaxMcTracks) :: imcwindows

nMCDeltas

integer (kind=i4), private :: nMCDeltas

Darray

integer (kind=i4), private, dimension (kMaxMcTracks) :: Darray

Dstartz

real (kind=r4), private, dimension (kMaxMcTracks) :: Dstartz

Dstopz

real (kind=r4), private, dimension (kMaxMcTracks) :: Dstopz

Dtime

real (kind=r4), private, dimension (kMaxMcTracks) :: Dtime

DSPminZ

real (kind=r4), private, dimension (kMaxMcTracks) :: DSPminZ

DSPmaxZ

real (kind=r4), private, dimension (kMaxMcTracks) :: DSPmaxZ

Dadded

logical, private, dimension (kMaxMcTracks) :: Dadded

MCTriggerWin

integer (kind=i4), private :: MCTriggerWin

nMCwindows

integer (kind=i4), public :: nMCwindows

MCwin

type (MCwin_type), public, DIMENSION(kMaxMcTracks), TARGET :: MCwin

Description of Subroutines and Functions

ClassifyingBJ

public function ClassifyingBJ () result (EventSelected)
    logical :: EventSelected
    ! Calls: BookTDClochists, EvalEvent, EvalEventMC, EvalEventPlanes, EvalEventPlanesMC, FillMCEventTypeHist, FillSkimN, FillTDClochists, HF1, LookforPossiblePieNu, fail_status, hf1, hf2
end function ClassifyingBJ
 FUNCTION ClassifyingBJ() RESULT (EventSelected)
----------------------------------------------------------------------------
 This subroutine classifies events before tracking is done.

 Once classifying is done, events can be selected for analysis, and or 
 skimming.  By default no skimming is done, and all events are analyzed.  To
 select certain event types to analyze, select how the classifying code 
 results will be used by setting name Classify SelectEvent to:
   SelectEvent Value   Outcome
   -----------------   -------
      -1               Analyze events which were NOT
                        selected by Classifying
       0 (default)     Classify events, but analyze
                        all events
       1               Analyze events which were
                        selected by Classifying
   any other value     Don't run classifying code, 
    (eg. 2)             analyze all events                      
 The type of event selected is set by setting one or more of the following 
 namelist values to be true:

 Also, the type of events to skim can be independently selected by 
 setting all the skim namelists to set up skimming channels, and setting
 one of the following namelist variables to true:

 This routine returns the a logical, which says whether the event was
 selected for analysis.

LookForPossiblePiEnu

private subroutine LookForPossiblePiEnu ()
end subroutine LookForPossiblePiEnu
 Subroutine LookForPossiblePiEnu
 ------------------------------------------------------
 See if the trigger window looks like it could be a 
 pi -> e nu Criteria are:
 1) muon width in scintillator &or upstream PC is muon like 
 2) looks like beam positron or fast decay downstream
 3) tcap of a pion
 4) not too many hits per plane
 5) pion should have stopped or decayed before reaching target
    this means tdc width will be 'small' for Tgt PC

FillTDClochists

private subroutine FillTDClochists ()
    ! Calls: FillTDCloc, uv2xy
end subroutine FillTDClochists

FillTDCloc

private subroutine FillTDCloc (igplane, r, x, y, t, PorD, hitspp)
    integer (kind=i4), intent(in) :: igplane
    real (kind=r4), intent(in) :: r
    real (kind=r4), intent(in) :: x
    real (kind=r4), intent(in) :: y
    real (kind=r4), intent(in) :: t
    character, intent(in) :: PorD
    real (kind=r4), intent(in) :: hitspp
    ! Calls: HF2, hf1
end subroutine FillTDCloc

BookTDClochists

private subroutine BookTDClochists ()
    ! Calls: HBOOK1, HBOOK2
end subroutine BookTDClochists

EvalEventMC

private subroutine EvalEventMC ()
    ! Calls: HF1, HF2, StartStopZtoGlobalPlane, fail_status, fillSPscatterZ, getSPextent, hf1, hf2
end subroutine EvalEventMC
 Subroutine EvalEventMC  (Blair Jamieson, Apr 2003)
 -------------------------------------------------------------
 This subroutine makes a classification based on tracks put in
 the MCTR bank.  A histogram comparison between the usual 
 event classification to MC event types is then done.
 Note that the MCEventTypes are the same as the regular event
 types, but classified using MCTR, rather than with the TDC
 bank info only.  

 EvalEventMC classifies events according to the following:
 MCEventType 1 ( Simple Clean ) Muon and Decay, well separated in time
             2 ( Time Clean )  Muon, Decay, and Beam Positrons well sep in time
             3 ( Simple DC Overlap ) Muon and Decay PC times separated in time
             4 ( Time DC Overlap ) Muon, Decay and Beam positron PC times sep in time
             5 ( PC Overlap ) Overlap of PC hits
             6 ( Simple Delta Cleaned ) Muon and Decay, well separated in time, delta removed
             7 ( Time Delta Cleaned ) Muon, Decay and beam positron well sep in time, delta removed
             8 ( Simple DC Overlap Delta Cleaned ) Muon and Decay, PC times separated in time, delta removed
             9 ( Time DC Overlap Delta Cleaned ) Muon, Decay and beam positron PC seperated in time, delta removed
            10 ( Simple Scatter Cleaned ) Muon and Decay, well separated in time, delta removed
            11 ( Time Scatter Cleaned ) Muon, Decay and beam positron well sep in time, delta removed
            12 ( Simple DC Overlap Scatter Cleaned ) Muon and Decay, PC sep in time, delta removed
            13 ( Time DC Overlap Scatter Cleaned ) Muon, Decay and beam positron PC sep in time, delta removed
            14 ( Beam Positron Trigger ) Event triggered by beam positron
            15 ( Multiple Muon Decays Simple Clean ) Two or more muon decays in order DC sep in time
            16 ( Multiple Muon Decays Time Clean ) Two or more muon decays in order with beam e+ DC sep in time
            17 ( Multiple Muon Decays DC Overlap Simple Clean ) Two or more muon decays in order PC sep in time
            18 ( Multiple Muon Decays DC Overlap Time Clean ) Two or more muon decays in order with beam e+ pc sep in time
            19 ( Multiple Muon Decays Dirty ) Two or more muon decays in wrong order
            20 ( Just a Muon and Beam Positrons )

            21 ( Simple Beam Positron Cleaned ) Muon and Decay, well separated, but with beam e+ PC overlap
            22 ( Time Beam Positron Cleaned ) Muon, Decay, and Beam positrons well separated, but with beam e+ PC overlap
            23 ( Simple DC OVerlap Beam Positron Cleaned ) Muon and Decay, well separated, but with beam e+ PC overlap
            24 ( Time DC OVerlap Beam Positron Cleaned ) Muon and Decay, well separated, but with beam e+ PC overlap

            25 ( Just beam positrons, unknown trigger) 
            26 ( Other, unknown trigger) 
            27 ( Other ) Whatever is left
            28 ( Simple Clean -- Too few planes hit ) for Type 1,6,10,15
            29 ( Time Clean -- Too few planes hit ) for Type 2,7,11,16
            30 ( Simple Clean -- Too high angle ) for Type 1,6,10,15
            31 ( Time Clean -- Too high angle ) for Type 2,7,11,16

getSPextent

private subroutine getSPextent (imc, minZ, maxZ, turnaround, hiddendelta)
    integer (kind=i4), intent(in) :: imc
    real (kind=r4), intent(out) :: minZ
    real (kind=r4), intent(out) :: maxZ
    logical, intent(out) :: turnaround
    logical, intent(out) :: hiddendelta
end subroutine getSPextent

fillSPscatterZ

private subroutine fillSPscatterZ (imc, endscatter)
    integer (kind=i4), intent(in) :: imc
    logical, INTENT(out) :: endscatter
end subroutine fillSPscatterZ

StartStopZtoGlobalPlane

private subroutine StartStopZtoGlobalPlane (startz, stopz, startP, stopP)
    real (kind=r4), INTENT(in) :: startz
    real (kind=r4), INTENT(in) :: stopz
    integer (kind=i4), INTENT(out) :: startP
    integer (kind=i4), INTENT(out) :: stopP
end subroutine StartStopZtoGlobalPlane
 
 SUBROUTINE  StartStopZtoGlobalPlane( startz, stopz, startP, stopP)
-------------------------------------------------------------------
 This subroutine coverts a tracks minimum z coordinate (startz), and
 maximum z coordinate (stopz) into minimum/first plane hit (startP) and
 maximum/last plane hit (stopP).  The plane numbers are global plane
 numbers. 

EvalEventPlanes

private subroutine EvalEventPlanes (EType)
    integer (kind=i4), intent(inout) :: EType
end subroutine EvalEventPlanes
 SUBROUTINE EvalEventPlanes(Etype)
--------------------------------------------------------------------------
 EvalEventPlanes re-classifies "clean" events.  All it does is look to see
 if decay positron windows in so called "clean" events have enough planes
 hit for tracking, and that it isn't a ridiculously high angle decay based
 on hits-per-plane and time-of-flight from PC's

EvalEventPlanesMC

private subroutine EvalEventPlanesMC (EType)
    integer (kind=i4), intent(inout) :: EType
end subroutine EvalEventPlanesMC
 SUBROUTINE EvalEventPlanesMC(Etype)
--------------------------------------------------------------------------
 EvalEventPlanes re-classifies "clean" events.  All it does is look to see
 if decay positron windows in so called "clean" events have enough planes
 hit for tracking, and that it isn't a ridiculously high angle decay based
 on hits-per-plane and time-of-flight from PC's

EvalEvent

private subroutine EvalEvent ()
end subroutine EvalEvent
 SUBROUTINE EvalEvent
----------------------------------------------------------------------------
 EvalEvent classifies events according to the following:
 EventType = 1 ( Simple Clean ) Muon and Decay, well separated in time
             2 ( Time Clean )  Muon, Decay, and Beam Positrons well sep in time
             3 ( Simple DC Overlap ) Muon and Decay PC times separated in time
             4 ( Time DC Overlap ) Muon, Decay and Beam positron PC times sep in time
             5 ( PC Overlap ) Overlap of PC hits
             6 ( Simple Delta Cleaned ) Muon and Decay, well separated in time, delta removed
             7 ( Time Delta Cleaned ) Muon, Decay and beam positron well sep in time, delta removed
             8 ( Simple DC Overlap Delta Cleaned ) Muon and Decay, PC times separated in time, delta removed
             9 ( Time DC Overlap Delta Cleaned ) Muon, Decay and beam positron PC seperated in time, delta removed
            10 ( Simple Scatter Cleaned ) Muon and Decay, well separated in time, delta removed
            11 ( Time Scatter Cleaned ) Muon, Decay and beam positron well sep in time, delta removed
            12 ( Simple DC Overlap Scatter Cleaned ) Muon and Decay, PC sep in time, delta removed
            13 ( Time DC Overlap Scatter Cleaned ) Muon, Decay and beam positron PC sep in time, delta removed
            14 ( Beam Positron Trigger ) Event triggered by beam positron
            15 ( Multiple Muon Decays Simple Clean ) Two or more muon decays in order DC sep in time
            16 ( Multiple Muon Decays Time Clean ) Two or more muon decays in order with beam e+ DC sep in time
            17 ( Multiple Muon Decays DC Overlap Simple Clean ) Two or more muon decays in order PC sep in time
            18 ( Multiple Muon Decays DC Overlap Time Clean ) Two or more muon decays in order with beam e+ pc sep in time
            19 ( Multiple Muon Decays Dirty ) Two or more muon decays in wrong order
            20 ( Just a Muon and Beam Positrons )
            21 ( Simple Beam Positron Cleaned ) Muon and Decay, well separated, but with beam e+ PC overlap
            22 ( Time Beam Positron Cleaned ) Muon, Decay, and Beam positrons well separated, but with beam e+ PC overlap
            23 ( Simple DC OVerlap Beam Positron Cleaned ) Muon and Decay, well separated, but with beam e+ PC overlap
            24 ( Time DC OVerlap Beam Positron Cleaned ) Muon and Decay, well separated, but with beam e+ PC overlap
            25 ( Just beam positrons, unknown trigger) 
            26 ( Other, unknown trigger) 
            27 ( Other ) Whatever is left
            28 ( Simple Clean -- Too few planes hit ) for Type 1,6,10,15
            29 ( Time Clean -- Too few planes hit ) for Type 2,7,11,16
            30 ( Simple Clean -- Too high angle ) for Type 1,6,10,15
            31 ( Time Clean -- Too high angle ) for Type 2,7,11,16
            32 ( Time muon DC Overlap only ) Muon, Decay and Beam positron PC times sep in time. Only muon window shortened
            33 ( Time DC Overlap Delta Cleaned ) Muon, Decay and beam positron PC seperated in time, delta removed. Only muon window shortened
            34 ( Time DC Overlap Scatter Cleaned ) Muon, Decay and beam positron PC sep in time, delta removed. Only muon window shortened
            35 ( Time DC OVerlap Beam Positron Cleaned ) Muon and Decay, well separated, but with beam e+ PC overlap. Only muon window shortened

FillMCEventTypeHist

private subroutine FillMCEventTypeHist ()
    ! Calls: HF1, HF2
end subroutine FillMCEventTypeHist

getPCVertex

public function getPCVertex (iwindow, iplane)
    integer (kind=i4) :: iwindow
    integer (kind=i4) :: iplane
    real (kind=r4) :: getPCVertex
end function getPCVertex

getDCVertex

public function getDCVertex (iwindow, iplane)
    integer (kind=i4) :: iwindow
    integer (kind=i4) :: iplane
    real (kind=r4) :: getDCVertex
end function getDCVertex

getGlobalPlaneExitFoilZ

public function getGlobalPlaneExitFoilZ (stopplane)
    integer (kind=i4) :: stopplane
    real (kind=r4) :: getGlobalPlaneExitFoilZ
end function getGlobalPlaneExitFoilZ
    FUNCTION getGlobalPlaneExitFoilZ( stopplane )
--------------------------------------------------------------
  This function takes a global plane number, and calculates the
  z of the exit foil of that plane.

getGlobalPlaneCenterZ

public function getGlobalPlaneCenterZ (stopplane)
    integer (kind=i4) :: stopplane
    real (kind=r4) :: getGlobalPlaneCenterZ
end function getGlobalPlaneCenterZ
    FUNCTION getGlobalPlaneCenterZ( stopplane )
--------------------------------------------------------------
  This function takes a global plane number, and calculates the
  z of the center of the plane.

FillWinUVPVertex

public subroutine FillWinUVPVertex (inwin, firstp, ipulast, ipvlast, ul, vl)
    integer (kind=i4), INTENT(in) :: inwin
    logical, INTENT(in) :: firstp
    integer (kind=i4), INTENT(out) :: ipulast
    integer (kind=i4), INTENT(out) :: ipvlast
    real (kind=r4), INTENT(out) :: ul
    real (kind=r4), INTENT(out) :: vl
    ! Calls: getpcdcfromglobal
end subroutine FillWinUVPVertex

FillWinDCUVPVertex

public subroutine FillWinDCUVPVertex (inwin, firstp, ipulast, ipvlast, ul, vl)
    integer (kind=i4), INTENT(in) :: inwin
    logical, INTENT(in) :: firstp
    integer (kind=i4), INTENT(out) :: ipulast
    integer (kind=i4), INTENT(out) :: ipvlast
    real (kind=r4), INTENT(out) :: ul
    real (kind=r4), INTENT(out) :: vl
    ! Calls: getpcdcfromglobal
end subroutine FillWinDCUVPVertex

getpcdcfromglobal

public subroutine getpcdcfromglobal (ip, idc, ipc, idirp)
    integer (kind=i4), INTENT(in) :: ip
    integer (kind=i4), INTENT(out) :: idc
    integer (kind=i4), INTENT(out) :: ipc
    integer, INTENT(out) :: idirp
end subroutine getpcdcfromglobal