*FILE MEMBER=acf_genPMTlist LIBRARY=SNOMAN LANGUAGE=FORTRAN77 DATE=05:Jul:2001
 <<<      SUBROUTINE acf_genPMTlist(FTpos,nHitPMT,PMTpos,
         +                        FirstRTCPMT,LastRTCPMT,DISCARD)
     
    *     ACF: Generate list of hit PMTs and sort them by hit time.  Call
    *          acf_WindowCut to determine which PMTs should be retained for the
    *          Time Exclusion Window
     
    *     Contact:  W. Heintzelman, Penn
    *     Verified: 
    *     Refereed: 
     
    *     Parameters:-
    *     ==========
    *     FTpos       in    Fitted event vertex position and time
    *     nHitPMT     out   Number of hit PMTs as counted by this routine
    *     PMTpos      out   Locations of hit PMTs relative to FTpos
    *     FirstRTCPMT out   Index of first PMT in the residual time window
    *     LastRTCPMT  out   Index of last  PMT in the residual time window
    *     DISCARD     in/   = .FALSE.
    *                 out   Set = .TRUE. if PMTpos array could not be filled
     
    *     Common Block Access:-
    *     ===================
     
    *     Specification:-
    *     =============
    *       Calculate the locations of the hit PMTs relative to the fitted vertex
    *       location and store them in array PMTpos in PMT hit time order.
    *       Also return the number of hit PMTs and the indices in the PMTpos
    *       array of the first and last PMTs that are within the residual time
    *       window.
     
    *     Program Notes:-
    *     =============
     
    *     Revision History:-
    *     ================
    *     4.02   W. Heintzelman   First version
    *            W. Heintzelman   Second version
     
          IMPLICIT NONE
     
          include 'bank_ev.inc'
          include 'bank_mast.inc'
          include 'bank_pmt.inc'
          include 'ge_mnemonics.inc'
          include 'ge_pmts.inc'
          INCLUDE 'zunit.inc'
          include 'z.inc'
     
    *     include 'su_mnemonics.inc' (This statement is in acf_evalconst.inc)
          include 'acf_evalconst.inc'
     
    *     Argument Declarations:-
    *     =====================
            integer nHitPMT,FirstRTCPMT,LastRTCPMT
            real FTpos(4), PMTpos(3,maxhits),PMTtime(maxhits)
            LOGICAL           DISCARD
     
    *ENDHEADER
     
    *     Local Variable Declarations:-
    *     ===========================
          integer i,tube_no,ievtno,tubelist(maxhits),levb
          real PMTtim
          logical keep
     
          SAVE
     
            levb = lq(lmast - kmast_ev)     ! Link to Event bank
            if (levb .eq. 0) then
                write(iqlog,*) 'acf_genPMTlist: No Event bank found.'
                DISCARD = .true.
                return
            endif
     
            ! We have to loop over events, because there may be more than one
            ! trigger event for a  single Monte Carlo event.
            nHitPMT = 0
            dowhile(levb.ne.0)
                ievtno = IQ(levb + KEV_EVN) ! Trigger event number
     
                lpmt = lq(levb - kev_pmt)   ! Link to PMT short fat bank
                if (lpmt .eq. 0) then
                    write(iqlog,*)
         +              'acf_genPMTlist: No PMT bank found. Event ',ievtno
                    DISCARD = .true.
                    return
                endif
     
                ! Consider only hit tubes in the event
                dowhile(lpmt.ne.0 .and. nHitPMT.lt.maxhits)
                    TUBE_NO = IQ(lpmt + kpmt_PN)
                    PMTtim = RQ(lpmt + kpmt_PT)
     
                    ! Check for multiple hits on the same tube:
                    keep = .true.
                    do i=1,nHitPMT
                        keep = keep .and. (tube_no.ne.tubelist(i))
                    enddo
     
                    ! Check for non-functioning PMT
                    keep = keep .and. (PMTtim.ne.-9999.)
     
                    if(keep) then
                        nHitPMT = nHitPMT + 1
                        tubelist(nHitPMT) = tube_no
                        PMTtime(nHitPMT) = PMTtim
                    else
    *                   write(iqlog,*)
    *     +             'Found multiple PMT hit or non-functioning PMT.'
    *     +             ,'  Event ',ievtno
                    endif
                    lpmt = LQ(lpmt)
                enddo
     
                levb = LQ(levb)
            enddo
     
            if(nHitPMT.ge.maxhits)
         +          Write(iqlog,*) 'acf_genPMTlist warning: ',
         +          ' Reached maximum capacity of PMTpos array.'
     
            ! Sort list of hit PMTs by residual hit time and find indices to
            ! first and last PMTs in the residual time window:
     
            call acf_windowcut
         +      (FTpos,nHitPMT,PMTtime,tubelist,FirstRTCPMT,LastRTCPMT)
     
            ! Copy the positions of the hit PMTs relative to the event vertex
            ! into PMTpos, in sorted order:
            do i=1,nHitPMT
                PMTpos(1,i) = RGE_PMT_XYZ(1,tubelist(i)) - FTpos(1)
                PMTpos(2,i) = RGE_PMT_XYZ(2,tubelist(i)) - FTpos(2)
                PMTpos(3,i) = RGE_PMT_XYZ(3,tubelist(i)) - FTpos(3)
            enddo
     
    *       write(iqlog,*)
    *               'acf_genPMTlist.  PMT IDs and hit times in time order:'
    *       write(iqlog,'(6(i5,f6.0)/)') (tubelist(i),PMTtime(i),i=1,nHitPMT)
     
            return
            end
    *endfile member=acf_genPMTlist