SUBROUTINE USER_EVNT
c
c_begin_doc
c  RCS ID string
c  $Id: user_evnt.F,v 1.3 1997/04/10 21:00:38 freyberg Exp $
c
c  Documentation for subroutine USER_EVNT
c
c  Purpose:  USER supplied EVENT processing routine, called once per event
c  --------
c
c  Input Parameters:  NONE
c  ----------------
c
c  Output Parameters: NONE
c  -----------------
c
c  Called from:
c  ------------
c
c  Other routines:
c  ---------------
c
c  Notes:
c  ------
c
c  Author:   Arne Freyberger      Created:  Wed Mar 15 14:01:23 EST 1995
c  -------
c
c  Major revisions:
c  ----------------
c     
c
c_end_doc
c
      IMPLICIT NONE
      SAVE
c
c_begin_inc
c  include files :
c  ---------------------
c BOS common block  uncomment the next line for BOS include file
#include "bcs.inc"
c_end_inc
c
c_begin_var
c  input/output variables:
c  -----------------------
c
c  Local pre-defined variables:
c  ---------------------------
c  RCS information: 
      CHARACTER*132  CFILE, CREVIS, CSTATE, CDATE, CAUTHO, CRCSID 
      PARAMETER ( CFILE = '$RCSfile: user_evnt.F,v $')
      PARAMETER ( CREVIS = '$Revision: 1.3 $')
      PARAMETER ( CSTATE = '$State: Exp $')
      PARAMETER ( CDATE = '$Date: 1997/04/10 21:00:38 $')
      PARAMETER ( CAUTHO = '$Author: freyberg $')
      DATA CRCSID/
     1'$Id: user_evnt.F,v 1.3 1997/04/10 21:00:38 freyberg Exp $
     3'/
c  Module information:
      CHARACTER*132  CRNAME, CRAUTH
      PARAMETER (CRNAME='USER_EVNT')
      PARAMETER (CRAUTH='Arne Freyberger')
c
c  Local User defined variables:
c  -----------------------------
      integer namind
      external namind
c      CHARACTER*132  CRMESS

      integer nami, ind, ns
      integer nrow
c
c     Tagger variables April 22nd, 1997
c
      integer ishft,iand
      integer nword,i
      integer slot,channel,value,edge
      integer ntagt
      integer e_counter,n_good,last_slot,last_channel
      integer*2 userd16(2000)
      integer*4 userd32(1000)
      equivalence (userd32,userd16)
c
c_end_var
c
c  executable code for routine USER_EVNT:
c  -------------------------------------
c
c
c     Initialization of various variables
c
      ntagt = 0
c
c  The following is just an example of how to fill histograms, including
c  changing PAWC directories.
c
      ns = ns + 1
c
c     Tagger Analysis Begins
c
        call hcdir('//PAWC/TAG',' ')
c
c
c     DECODING OF THE E-counter data
c     Note the new variant: (oct 9th)
c
       call blist(iw,'E+','RC11')
       nami = namind('RC11')
       ind = IW(nami)
c
c     Load data array
c       
       if (ind.ne.0) then
          nword = iw(ind)
          do i=1,nword
             userd32(i) =  iw(ind+i)
          enddo
       endif
c
       last_slot=ishft(userd32(1),-27)
       last_channel = 1
       n_good=1
       do i=2,nword
c
c     Decode the geographical location of the data event
c     slot = slot number of event
c     channel = channel number of event
c     value = tdc data
c     edge = rising or falling edge?
c
          slot=ishft(userd32(i),-27)
          if (last_slot.eq.slot.and.slot.ne.31.and.slot.ne.0) then
                channel=ISHFT(IAND(userd32(i),'00FE0000'x),-17)
                value=IAND(userd32(i),'00000FFF'x) !TDC 12 bit
                edge=ISHFT(IAND(userd32(i),'00010000'x),-16)
c
c     Once data is decoded histogram it.
c
                if (edge.eq.1) then
                   if (slot.eq.6) then
                      e_counter = channel+1
                      call hf1(e_counter,float(value),1.)
                   else if (slot.eq.10) then
                      e_counter = channel + 97
                      call hf1(e_counter,float(value),1.)
                   else if (slot.eq.14) then
                      e_counter = channel + 193
                      call hf1(e_counter,float(value),1.)
                   else if (slot.eq.18) then
                      e_counter = channel + 289
                      call hf1(e_counter,float(value),1.)
                   else
c     write(6,*) 'error in e-counter decoding--- Slot= ',slot
                   endif
                endif
          else if (slot.ne.31) then
                last_slot=slot
          endif
             
         
       enddo  
c
c     Analysis of the scalers
c
       call blist(iw,'E+','TGS ')
       nami = namind('TGS ')
       ind = IW(nami)
       do while (ind.ne.0)
          write(6,*) 'have a tgs event'
          nword = iw(ind)
          nrow = iw(ind-4)
          
          do i=1,nword
             userd32(i) = iw(ind+i)
          enddo
c
c     First handle the raw data banks
c
          do i=1,64
             call hf1(401,float(i),float(userd32(i)))
          enddo
c          
          ind = iw(ind-1)
       enddo

       call blist(iw,'E+','SCS ')
       nami = namind('SCS ')
       ind = IW(nami)
       do while (ind.ne.0)
          write(6,*) 'have a scs event'
          nword = iw(ind)
          nrow = iw(ind-4)
          
          do i=1,nword
             userd32(i) = iw(ind+i)
          enddo
c
c     Handle the ungated scaler banks
c
          do i=1,64
             call hf1(401,float(i),float(userd32(i)))
          enddo
c          
          ind = iw(ind-1)
       enddo
       
c
c change back to top directory
c       
      call hcdir('//PAWC',' ')

       RETURN
       END
c
c----------------------------------------------------------------------