subroutine hec_his_ini
c
c book online histograms 
c
c this booking routine is called before the pass over events
c it should only be used to book histos that must be filled 
c every event. 
c
      implicit none
c
      include'hec_par.inc'      ! shared parameters
      include'hec_datacard.inc' ! datacard values
      include'hec_geo.inc'      ! geometry correspondance tables
      include'hec_his_sys.inc'  ! histo ids, etc.
      include'hec_hvstat.inc'   ! hv status common
      include'hec_imp.inc'      ! impact parameter points
      include'hec_runh.inc'     ! run header common
c
c local variables
c
      integer i_z, i, ic, i_t, k
      character*70 ct,ctc,cthv
      character*1 cd
      character*4 c4
      integer nbin
      integer id, id_cal, id_cal_hv
      real hrange
c
c zero our moments arrays
c
      do i = 1, 3
        do ic = 1, i_adc_dim
          maxmom(ic, i) = 0.d0
          do i_t = 1, i_tim_dim
            adcmom(ic, i_t, i) = 0.d0
          enddo
          do i_t = 1, ntdc_bin
            tdcmom(ic, i_t, i) = 0.d0
          enddo
        enddo
      enddo
c
c zero time evolution arrays
c
      call vzero( adc_ped_time_ic1, 100)
      call vzero( adc_ped_time_ic2, 100)
      call vzero( adc_ped_time_ic3, 100)
      call vzero( adc_ped_time_ic4, 100)
c
c header information histos
c
      call hbook1(5550,'run number',1,1.,-1.,0.)
      call hbook1(5551,'particle type',1,1.,-1.,0.)
      call hbook1(5552,'particle energy',1,1.,-1.,0.)
      call hbook1(5553,'x_cryo',1,1.,-1.,0.)
      call hbook1(5554,'y_table',1,1.,-1.,0.)
      call hfill(5550,float(run_no),0.,1.)
      call hfill(5551,float(i_part),0.,1.)
      call hfill(5552,e_beam,0.,1.)
      call hfill(5553,x_cryo,0.,1.)
      call hfill(5554,y_tabl,0.,1.)
c 
      print *, ' *** booking event by event histograms'
c
c histo type 1 -- ped/noise/scaler
c for aug01 onwards, book scaler block histograms
c
      if (histo_switch(1) .eq. 1) then
        if (irunpd .ge. 15) then
          nbin = 100
          id = id_sc + 1
          ct = 'time between events (milli sec)'
          call hbook1(id, ct, nbin, 0., 50., 0.)
c
          id = id_sc + 2
          ct = 'pre-triggers between events'
          call hbook1(id, ct, nbin, 0., 2500., 0.)
c
          id = id_sc + 3
          ct = 'W triggers between events'
          call hbook1(id, ct, nbin, 0., 25000., 0.)
c
          id = id_sc + 11
          ct = 'pre-triggers per milli sec'
          call hbook1(id, ct, nbin, 0., 1000., 0.)
c
          id = id_sc + 12
          ct = 'W triggers per milli sec'
          call hbook1(id, ct, nbin, 0., 10000., 0.)
c
          id = id_sc + 21
          ct = 'pre-triggers per milli sec vs event no in burst'
          call hbprof(id, ct, nbin, 0., 300., 0., 1000., ' ')
c
          id = id_sc + 22
          ct = 'W triggers per milli sec vs event no in burst'
          call hbprof(id, ct, nbin, 0., 300., 0., 10000., ' ')
        endif
      endif
c
c histo type 4 -- tdc correction
c
      print *, ' *** histo_switch is ',histo_switch

      if (histo_switch(4) .eq. 1) then
c
c tdc distribution 
c
        nbin = 100
        write(c4, '(i4)') ic
        ct = 'tdc distribution (ns)'
        id = id_tdcd 
        call hbook1(id, ct, nbin, 0., 100., 0.)
      endif
c
c histo type 2 -- geometrical energy distribution
c
      if (histo_switch(2) .eq. 1) then
c
c pedestal subtracted energy distribution for each depth
c
        nbin = 100
        do i_z = 1, i_z_used
          write(cd, '(i1)') i_z
          ct = 'adc - pedestal for tower depth '//cd
          id = id_adc_z + i_z
          call hbook1(id, ct, nbin, 1., -1., 0.)
          call hidopt(id, 'STAT' )
        enddo
      endif
c
c book histograms for each channel
c
      do ic = 1, i_adc_used
c
c skip booking for disconnected channels
c
        if(ic_connected(ic))then
c
c histo type 3 -- no calibration, no tdc correction
c
        if (histo_switch(3) .eq. 1) then
c
c pedestal subtracted energy distribution for each channel
c in the case of muons, use one bin per adc
c
          nbin = 100
          write(c4, '(i4)') ic
          ct = 'adc - pedestal for channel'//c4
          id = id_adc_ic + ic
          if (i_part .eq. 2) then
            call hbook1(id, ct, nbin+20, -20., real(nbin), 0.)
          else
            call hbook1(id, ct, nbin, -100., 2000., 0.)
          endif
c          call hidopt(id, 'STAT')   ! not compatible with fast filling
c
c time(max) distribution in ns for each channel for 1997 or later
c
          if (irunpd .ge. 4) then
            nbin = 100
            write(c4, '(i4)') ic
            ct = 'time of max for ch.'//c4//'(ns)'
            id = id_tim_ic + ic
            call hbook1(id, ct, nbin, 0. , 25.*i_tim_used , 0.)
          endif
c
        endif
c
c histo type 4 -- tdc corrected
c
        if (histo_switch(4) .eq. 1) then
c
c time(max) distribution in ns (TDC corrected) for each channel 
c for 1997 or later for cubic fit only
c
          if (irunpd .ge. 4 .and. m_pref .eq. 1) then
            nbin = 500
            write(c4, '(i4)') ic
            ct = 'time of max +TDC for ch.'//c4//' (ns) (cubic fit)'
            id = id_tim_icns + ic
            call hbook1(id, ct, nbin, 0.5 , nbin+0.5 , 0.)
          endif
        endif
c
c histo type 5 -- Calibration correction
c
        if (histo_switch(5) .eq. 1) then
c
c calibrated energy for each channel, if calibration is turned on
c
          nbin = 100
          if (io_cal(1) .gt. 0) then
            write(c4, '(i4)') ic
            ct = 'energy in nA for channel'//c4
            id = id_cal_ic + ic
            call hbook1(id, ct, nbin, 1., -1., 0.)
            call hidopt(id, 'STAT')  
          endif
c
        endif
c
        endif
c
      enddo
 
c
c histo type 5 -- Calibration correction
c
      if (histo_switch(5).eq.1 .and. io_cal(1).ge.1) then
c
c calibrated energy if above sigma cut
c
        ct = 'total energy (nA) - channels above 1 sigma '
        id = id_sigma + 1
        call hbook1(id, ct, nbin, 0., 400.*e_beam, 0.)  
        ct = 'total energy (nA) - channels above 2 sigma '
        id = id_sigma + 2
        call hbook1(id, ct, nbin, 0., 400.*e_beam, 0.)  
        ct = 'total energy (nA) - channels above 3 sigma '
        id = id_sigma + 3
        call hbook1(id, ct, nbin, 0., 400.*e_beam, 0.)
c
c calibrated energy if above sigma cut
c
        if(e_beam.le.80)then
           hrange=2.0*e_beam
           if(i_part.eq.3)hrange=3.0*e_beam
        else
           hrange=1.5*e_beam
           if(i_part.eq.3)hrange=1.7*e_beam
        endif
        ct = 'total energy (GeV) - channels above 1 sigma'
        id = id_sigma + 4
        call hbook1(id, ct, nbin, 0., hrange, 0.)  
        ct = 'total energy (GeV) - channels above 2 sigma'
        id = id_sigma + 5
        call hbook1(id, ct, nbin, 0., hrange, 0.)  
        ct = 'total energy (GeV) - channels above 3 sigma cut'
        id = id_sigma + 6
        call hbook1(id, ct, nbin, 0., hrange, 0.)
c
c calibrated and HV corrected energy if above sigma cut 
c Book them only if slow control bank is there
c
        if(lhvstat)then
           ct = 'total HV corrected energy (GeV) - 1 sigma cut'
           id = id_sigma + 7
           call hbook1(id, ct, nbin, 0., hrange, 0.)  
           ct = 'total HV corrected energy (GeV) - 2 sigma cut'
           id = id_sigma + 8
           call hbook1(id, ct, nbin, 0., hrange, 0.)  
           ct = 'total HV corrected energy (GeV) - 3 sigma cut'
           id = id_sigma + 9
           call hbook1(id, ct, nbin, 0., hrange, 0.)
        endif
      endif  

c
c histo type 6 -- Clustered Energy
c
      if (histo_switch(6) .eq. 1) then
c
c fill the array his_clus_index that contains the cluster numbers for the
c clusters that are used (poll on the number of cells)
c fill his_clus_num, the total number of filled entries in his_clus_index
c
        call vzero(his_clus_index, nclust_dim)
        his_clus_num = 0
        do i = 1, nclust_dim
          if (his_clus_cell_array(1, i) .gt. 0) then
            his_clus_num = his_clus_num + 1
            his_clus_index(his_clus_num) = i
          endif
        enddo
c
c Convert Hollerith integer back into characters for clustering titles
c
        do k = 1, his_clus_num
          call UHTOC (his_clus_ititle(his_clus_index(k)),4,
     +                his_clus_title(his_clus_index(k)),4)
        enddo
c
c set depth weights for cluster
c
        do i = 1, i_z_max
          if (i .le. 2) then
            depthw_adc(i) = 1.
            depthw_na(i)  = 1.
          else
            depthw_adc(i) = 2.
            depthw_na(i)  = 2.
          endif
        enddo
c
c for run periods 9 and above, the ADC value is already multiplied by two
c in the electronics
c
        if (irunpd .ge. 9) then
          do i = 3, i_z_max
            depthw_adc(i) = 1.
          enddo
        endif
c
c cluster histogram ranges
c
        if(e_beam.eq.0)then
           hrange=50.
        else if(e_beam.le.80)then
           hrange=2.0*e_beam
           if(i_part.eq.3)hrange=3.0*e_beam
        else
           hrange=1.3*e_beam
           if(i_part.eq.3)hrange=1.5*e_beam
        endif

        do k = 1, his_clus_num
          write (c4,'(a4)') his_clus_title(his_clus_index(k))
          write (ct,8) his_clus_title(his_clus_index(k))
 8        format ('Energy Cluster  ',A4)
          write (ctc,9) his_clus_title(his_clus_index(k))
 9        format ('Calibrated energy, Cluster  ',A4)
          write (cthv,10) his_clus_title(his_clus_index(k))
 10       format ('HV corrected and calibrated energy, cluster  ',A4)
          id = id_clus + k
          id_cal = id_clus_cal + k
          id_cal_hv = id_clus_cal_hv + k
          if (c4(3:4) .eq. 'mu') then
             if(ct(17:17).ne.'Z')then
                call hbook1(id, ct, 150, -50., 100., 0.)
             else
                call hbook1(id, ct, 100, -100., 400., 0.)
             endif
             if(io_cal(1).ge.1)then
               if(ct(17:17).ne.'Z')then
                  call hbook1(id_cal, ctc, 80, -50., 30., 0.)
                  if(lhvstat)then
                     call hbook1(id_cal_hv, cthv, 100, -50., 30., 0.)
                  endif
               else
                  call hbook1(id_cal, ctc, 150, -50., 100., 0.)
                  if(lhvstat)then
                     call hbook1(id_cal_hv, cthv, 150, -50., 100., 0.)
                  endif
               endif
            endif
          else
            if(e_beam.ne.0)then
               call hbook1(id, ct, 100, -50., 15.*e_beam, 0.)
            else
               if(ct(17:17).ne.'Z')then
                  if (c4(3:4) .eq. 'pi') then
                     call hbook1(id, ct, 100, -50., 400., 0.)
                  else
                     call hbook1(id, ct, 100, -50., 100., 0.)
                  endif
               else
                  if (c4(3:4) .eq. 'pi') then
                     call hbook1(id, ct, 100, -50., 1000., 0.)
                  else
                     call hbook1(id, ct, 100, -50., 400., 0.)
                  endif
               endif
            endif
            if(io_cal(1).ge.1)then
               if(ct(17:17).eq.'Z'.and.e_beam.eq.0.and.
     &              i_part.eq.3)then
                  hrange=100.
               endif
               call hbook1(id_cal, ctc, 100, -20., hrange, 0.)
               if(lhvstat)then
                  call hbook1(id_cal_hv,cthv,100,-20., hrange,0.)
               endif
            endif
          endif
          call hidopt(id, 'STAT')
          if(io_cal(1).ge.1)then
             call hidopt(id_cal, 'STAT')
             if(lhvstat)then
                call hidopt(id_cal_hv, 'STAT')
             endif
          endif
        enddo
c
c find cluster corresponding to impact point and store index
c in common block for later copy
c
        impact_point_index=0
        i=0
        do while (impact_point_index.eq.0.and.i.lt.impmax)
           i=i+1
           if(x_cryo.eq.impact_point_x(i) .or.
     &        x_cryo*10.eq.impact_point_x(i))then
              if(y_tabl.eq.impact_point_y(i).or.
     &           y_tabl*10.eq.impact_point_y(i))then
                 impact_point_index=i
              endif
           endif
        enddo
      endif
c
      print *, ' *** end of event histogram booking'
c
      return
      end