1 cdaq 1.2 *=======================================================================
2 subroutine h_cal(abort,errmsg)
3 *=======================================================================
|
4 cdaq 1.1 *-
|
5 cdaq 1.2 *- Purpose: Computes the calorimeter particle ID quantities.
6 *- Corrects the energy depositions for impact point
7 *- coordinate dependence.
|
8 cdaq 1.1 *-
|
9 cdaq 1.2 *- Input Bank: HMS_TRACKS_CAL
|
10 cdaq 1.1 *-
|
11 cdaq 1.2 *- Output Bank: HMS_TRACK_TESTS
|
12 cdaq 1.1 *-
13 *- Output: ABORT - success or failure
14 *- : err - reason for failure, if any
15 *-
|
16 cdaq 1.2 *- Created: 15 Mar 1994 Tsolak A. Amatuni
17 *
18 * $Log: h_cal.f,v $
|
19 jones 1.11 * Revision 1.10 2002/09/26 14:31:56 jones
20 * the energy determination for planes A and B can use
21 * both pos and neg PMT depending on setting of hcal_num_neg_columns.
22 *
|
23 jones 1.10 * Revision 1.9 1999/06/10 16:46:58 csa
24 * (JRA) Cosmetic changes
25 *
|
26 csa 1.9 * Revision 1.8 1999/02/25 20:10:48 saw
27 * Vardan Tadevosyan shower code updates
28 *
|
29 saw 1.8 * Revision 1.7 1999/02/03 21:13:22 saw
30 * Code for new Shower counter tubes
31 *
|
32 saw 1.7 * Revision 1.6 1999/01/21 21:40:13 saw
33 * Extra shower counter tube modifications
34 *
|
35 saw 1.6 * Revision 1.5 1998/12/17 22:02:38 saw
36 * Support extra set of tubes on HMS shower counter
37 *
|
38 saw 1.5 * Revision 1.4 1995/05/22 19:39:04 cdaq
39 * (SAW) Split gen_data_data_structures into gen, hms, sos, and coin parts"
40 *
|
41 cdaq 1.4 * Revision 1.3 1994/09/13 19:39:14 cdaq
42 * (JRA) Add preshower energy
43 *
|
44 cdaq 1.3 * Revision 1.2 1994/04/12 21:24:55 cdaq
45 * (DFG) Put in real code and change name of print routine.
46 *
|
47 cdaq 1.2 * Revision 1.1 1994/02/19 06:12:35 cdaq
48 * Initial revision
49 *
|
50 cdaq 1.1 *--------------------------------------------------------
|
51 cdaq 1.2 implicit none
52 save
|
53 csa 1.9
|
54 cdaq 1.2 logical abort
55 character*(*) errmsg
|
56 jones 1.11
|
57 cdaq 1.2 character*5 here
58 parameter (here='H_CAL')
|
59 csa 1.9
|
60 cdaq 1.2 integer*4 nt !Detector track number
61 integer*4 nc !Calorimeter cluster number
|
62 saw 1.8 real*4 cor !Correction factor for X,Y dependenc. ! Single PMT
|
63 saw 1.6 real*4 cor_pos !Correction factor for X,Y dependenc. ! Single "POS_PMT"
64 real*4 cor_neg !Correction factor for X,Y dependenc. ! Single "NEG_PMT"
|
65 saw 1.8 real*4 h_correct_cal !External function to compute "cor".
|
66 saw 1.6 real*4 h_correct_cal_pos !External function to compute "cor_pos".
67 real*4 h_correct_cal_neg !External function to compute "cor_neg"
68
|
69 cdaq 1.4 include 'hms_data_structures.cmn'
|
70 cdaq 1.2 include 'hms_calorimeter.cmn'
|
71 cdaq 1.1 *
|
72 csa 1.9 *--------------------------------------------------------
73 *
|
74 cdaq 1.3 do nt=1,hntracks_fp
|
75 jones 1.11 htrack_e1_pos(nt)=0. ! Only pos_pmt for layer "A"
76 htrack_e1_neg(nt)=0. ! Only_neg_pmt for layer "A"
77 htrack_e2_pos(nt)=0. ! Only_pos_pmt for layer "B"
78 htrack_e2_neg(nt)=0. ! Only_neg_pmt for layer "B"
|
79 cdaq 1.2 htrack_e1(nt)=0.
80 htrack_e2(nt)=0.
81 htrack_e3(nt)=0.
82 htrack_e4(nt)=0.
83 htrack_et(nt)=0.
|
84 cdaq 1.3 htrack_preshower_e(nt)=0.
|
85 cdaq 1.2 enddo
|
86 csa 1.9
|
87 cdaq 1.2 call h_clusters_cal(abort,errmsg)
88 if(abort) then
89 call g_add_path(here,errmsg)
90 return
91 endif
|
92 csa 1.9
|
93 cdaq 1.2 call h_tracks_cal(abort,errmsg)
94 if(abort) then
95 call g_add_path(here,errmsg)
96 return
97 endif
|
98 cdaq 1.1 *
|
99 cdaq 1.2 * Return if there are no tracks found or none of the found
100 * tracks matches a cluster in the calorimeter.
101 *
|
102 jones 1.11 if(hntracks_fp .le.0) go to 100 !Return
103 if(hntracks_cal.le.0) go to 100 !Return
|
104 csa 1.9
|
105 cdaq 1.2 do nt =1,hntracks_fp
|
106 jones 1.11
|
107 cdaq 1.2 nc=hcluster_track(nt)
|
108 saw 1.6
|
109 cdaq 1.2 if(nc.gt.0) then
|
110 jones 1.11 cor =h_correct_cal(htrack_xc(nt),htrack_yc(nt)) ! For single "pmt"
111 cor_pos=h_correct_cal_pos(htrack_xc(nt),htrack_yc(nt)) ! For single "pos_pmt"
112 cor_neg=h_correct_cal_neg(htrack_xc(nt),htrack_yc(nt)) ! For single "neg_pmt"
113
114 hnblocks_cal(nt)=hcluster_size(nc)
115 *
116 if(hcal_num_neg_columns.ge.1) then
117 htrack_e1_pos(nt)=cor_pos*hcluster_e1_pos(nc) ! For "A" layer "POS_PMT"
118 htrack_e1_neg(nt)=cor_neg*hcluster_e1_neg(nc) ! For "A" layer "NEG_PMT"
119 htrack_e1(nt)=htrack_e1_pos(nt)+htrack_e1_neg(nt) ! For "A" layer "POS"+"NEG_PMT"
120 else
121 htrack_e1(nt)=cor_pos*hcluster_e1(nc) ! IF ONLY "POS_PMT" in layer "A"
122 endif
123
124 if(hcal_num_neg_columns.ge.2) then
125 htrack_e2_pos(nt)=cor_pos*hcluster_e2_pos(nc) ! For "B" layer "POS_PMT"
126 htrack_e2_neg(nt)=cor_neg*hcluster_e2_neg(nc) ! For "B" layer "NEG_PMT"
127 htrack_e2(nt)=htrack_e2_pos(nt)+htrack_e2_neg(nt) ! For "B" layer "POS"+"NEG_PMT"
128 else
129 htrack_e2(nt)=cor_pos*hcluster_e2(nc) ! IF ONLY "POS_PMT" in layer "B"
130 endif
131 jones 1.11
132 if(hcal_num_neg_columns.ge.3) then
133 print *,"Extra tubes on more than two layers not supported"
134 endif
135
136 htrack_e3(nt)=cor*hcluster_e3(nc)
137 htrack_e4(nt)=cor*hcluster_e4(nc)
138
139 htrack_et(nt)=htrack_e1(nt)+htrack_e2(nt)+ htrack_e3(nt)
140 & +htrack_e4(nt)
141
142 htrack_preshower_e(nt)=htrack_e1(nt)
143
144 endif !End ... if nc > 0
|
145 csa 1.9
|
146 jones 1.11 enddo !End loop over detector tracks
|
147 csa 1.9
|
148 jones 1.11 100 continue
|
149 cdaq 1.2 if(hdbg_tests_cal.gt.0) call h_prt_cal_tests
|
150 csa 1.9
|
151 cdaq 1.2 return
152 end
|