*=======================================================================
      subroutine h_cal(abort,errmsg)
*=======================================================================
*-
*-      Purpose: Computes the calorimeter particle ID quantities.
*-               Corrects the energy depositions for impact point 
*-               coordinate dependence.
*-
*-      Input Bank: HMS_TRACKS_CAL
*-
*-      Output Bank: HMS_TRACK_TESTS
*-
*-   Output: ABORT           - success or failure
*-         : err             - reason for failure, if any
*- 
*-      Created: 15 Mar 1994      Tsolak A. Amatuni
*
* $Log: h_cal.f,v $
* Revision 1.11  2003/04/03 00:43:13  jones
* Update to calibration (V. Tadevosyan0
*
* Revision 1.10  2002/09/26 14:31:56  jones
*     the energy determination for planes A and B can use
*     both pos and neg PMT depending on setting of hcal_num_neg_columns.
*
* Revision 1.9  1999/06/10 16:46:58  csa
* (JRA) Cosmetic changes
*
* Revision 1.8  1999/02/25 20:10:48  saw
* Vardan Tadevosyan shower code updates
*
* Revision 1.7  1999/02/03 21:13:22  saw
* Code for new Shower counter tubes
*
* Revision 1.6  1999/01/21 21:40:13  saw
* Extra shower counter tube modifications
*
* Revision 1.5  1998/12/17 22:02:38  saw
* Support extra set of tubes on HMS shower counter
*
* Revision 1.4  1995/05/22 19:39:04  cdaq
* (SAW) Split gen_data_data_structures into gen, hms, sos, and coin parts"
*
* Revision 1.3  1994/09/13  19:39:14  cdaq
* (JRA) Add preshower energy
*
* Revision 1.2  1994/04/12  21:24:55  cdaq
* (DFG) Put in real code and change name of print routine.
*
* Revision 1.1  1994/02/19  06:12:35  cdaq
* Initial revision
*
*--------------------------------------------------------
      implicit none
      save

      logical abort
      character*(*) errmsg

      character*5 here
      parameter (here='H_CAL')

      integer*4 nt           !Detector track number
      integer*4 nc           !Calorimeter cluster number
      real*4 cor         !Correction factor for X,Y dependenc.   ! Single   PMT
      real*4 cor_pos     !Correction factor for X,Y dependenc.   ! Single  "POS_PMT"
      real*4 cor_neg     !Correction factor for X,Y dependenc.   ! Single  "NEG_PMT" 
      real*4 h_correct_cal              !External function to compute "cor". 
      real*4 h_correct_cal_pos          !External function to compute "cor_pos". 
      real*4 h_correct_cal_neg          !External function to compute "cor_neg"   

      include 'hms_data_structures.cmn'
      include 'hms_calorimeter.cmn'
*
*--------------------------------------------------------
*
      do nt=1,hntracks_fp
         htrack_e1_pos(nt)=0.   !  Only pos_pmt for layer "A"
         htrack_e1_neg(nt)=0.   !  Only_neg_pmt for layer "A"
         htrack_e2_pos(nt)=0.   !  Only_pos_pmt for layer "B"  
         htrack_e2_neg(nt)=0.   !  Only_neg_pmt for layer "B" 
         htrack_e1(nt)=0.
         htrack_e2(nt)=0.
         htrack_e3(nt)=0.
         htrack_e4(nt)=0.
         htrack_et(nt)=0.
         htrack_preshower_e(nt)=0.
      enddo

      call h_clusters_cal(abort,errmsg)
      if(abort) then
         call g_add_path(here,errmsg)
         return
      endif

      call h_tracks_cal(abort,errmsg)
      if(abort) then
         call g_add_path(here,errmsg)
         return
      endif
*
*      Return if there are no tracks found or none of the found
*      tracks matches a cluster in the calorimeter.
*
      if(hntracks_fp .le.0) go to 100 !Return
      if(hntracks_cal.le.0) go to 100 !Return

      do nt =1,hntracks_fp

         nc=hcluster_track(nt)

         if(nc.gt.0) then
            cor    =h_correct_cal(htrack_xc(nt),htrack_yc(nt)) ! For single "pmt"
            cor_pos=h_correct_cal_pos(htrack_xc(nt),htrack_yc(nt)) ! For single "pos_pmt"
            cor_neg=h_correct_cal_neg(htrack_xc(nt),htrack_yc(nt)) ! For single "neg_pmt"

            hnblocks_cal(nt)=hcluster_size(nc)
*
            if(hcal_num_neg_columns.ge.1) then
               htrack_e1_pos(nt)=cor_pos*hcluster_e1_pos(nc) !  For "A" layer "POS_PMT"    
               htrack_e1_neg(nt)=cor_neg*hcluster_e1_neg(nc) !  For "A" layer "NEG_PMT"
               htrack_e1(nt)=htrack_e1_pos(nt)+htrack_e1_neg(nt) !  For "A" layer "POS"+"NEG_PMT"
            else
               htrack_e1(nt)=cor_pos*hcluster_e1(nc) !   IF ONLY "POS_PMT" in layer "A"                
            endif

            if(hcal_num_neg_columns.ge.2) then
               htrack_e2_pos(nt)=cor_pos*hcluster_e2_pos(nc) !  For "B" layer "POS_PMT"    
               htrack_e2_neg(nt)=cor_neg*hcluster_e2_neg(nc) !  For "B" layer "NEG_PMT"
               htrack_e2(nt)=htrack_e2_pos(nt)+htrack_e2_neg(nt) !  For "B" layer "POS"+"NEG_PMT"
            else
               htrack_e2(nt)=cor_pos*hcluster_e2(nc) !   IF ONLY "POS_PMT" in layer "B"
            endif

            if(hcal_num_neg_columns.ge.3) then
               print *,"Extra tubes on more than two layers not supported"
            endif

            htrack_e3(nt)=cor*hcluster_e3(nc)  
            htrack_e4(nt)=cor*hcluster_e4(nc)

            htrack_et(nt)=htrack_e1(nt)+htrack_e2(nt)+ htrack_e3(nt)
     &           +htrack_e4(nt) 

            htrack_preshower_e(nt)=htrack_e1(nt)

         endif                  !End ... if nc > 0

      enddo                     !End loop over detector tracks

 100  continue
      if(hdbg_tests_cal.gt.0) call h_prt_cal_tests

      return
      end