1 cdaq 1.1 subroutine s_one_ev_generate
2 *
3 * $Log:$
4
5 implicit none
6
7 include 'sos_data_structures.cmn'
8 include 'sos_tracking.cmn'
9 include 'sos_geometry.cmn'
10 include 'sos_calorimeter.cmn'
11 include 'gen_event_info.cmn'
12 include 'gen_run_info.cmn'
13 include 'sos_one_ev.par'
14 include 'gen_one_ev_gctrak.cmn'
15 include 'gen_one_ev_gckine.cmn'
16 include 'gen_one_ev_gcvolu.cmn'
17
18 character*4 lnames(0:3) ! volume names
19 integer lnums(0:3) ! volume numbers or copies
20 real xd(3), xm(3) ! coordinates
21 integer error_code ! error return code
22 cdaq 1.1 integer chamhit,scinhit,showhit ! index variables
23 integer wirenum ! indicates GEANT wirenumber
24
25 character*5 wire !define names and indicies to loop over...
26 character*5 scinname
27 character*4 blockname
28 character*5 layername
29
30 *
31 * Reset the detector hit indicators...
32 call s_one_ev_det_reset
33 *
34 * Clear any previous drawing
35 *
36 call iclrwk (0, 0)
37 call gtrigc
38 call gtrigi
39 *
40 * define some colors for the various wires, and turn shading on
41 *
42 call iscr(1,1,.5,.5,.5) !make the detectors grey
43 cdaq 1.1 call iscr(1,15,1.,0.7,0.2) !define an "orange"
44 call iscr(1,13,0.,.65,0.) !define a "dark green"
45 call iscr(1,14,0.,0.,1.) !define a dark blue
46 call gdopt ('SHAD','ON')
47
48 *
49 * Now loop over all the detector elements "lighting" each one if it has been hit
50 *
51 xd(1) = 0. ! find the center of the detector
52 xd(2) = 0. ! find the center of the detector
53 xd(3) = 0. ! find the center of the detector
54 * Start with the wire chambers
55 * See the file "displaynumbering.help" for a description of the numbering of the
56 * various detector elements
57 *
58 if (SDC_TOT_HITS .GT. 0) then
59 lnames(0) = 'SHUT'
60 lnums(0) = 1
61 do chamhit = 1, SDC_TOT_HITS
62 **************************************************************************************
63 *UUU
64 cdaq 1.1 ****
65 if (SDC_PLANE_NUM(chamhit) .EQ. 1) then
66 nlevel = 0 ! initial value for # of levels
67 lnames(1) = 'WCHA' ! level one
68 lnums(1) = 1 ! copy one, higher chamber
69 lnames(2) = 'WAAU' ! U plane
70 lnums(2) = 1 ! copy one
71 wirenum = nint(sdc_nrwire(SDC_PLANE_NUM(chamhit))) + 1
72 & - SDC_WIRE_NUM(chamhit)
73 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
74 & wirenum = SDC_WIRE_NUM(chamhit)
75 if (wirenum .le. 24) write(wire,'(a,a,a,a)') 'AUA',char(64 + wirenum)
76 if (wirenum .gt. 24) write(wire,'(a,a,a,a)') 'AUB',char(64 - 24 + wirenum)
77 lnames(3) = wire ! U wires
78 lnums(3) = wirenum ! wire number
79 call glvolu (4, lnames, lnums, error_code)
80 call gdtom (xd, xm, 1) ! transform from detector to MARS
81 call gsatt (wire,'SEEN',1)
82 call gsatt (wire,'COLO',13)
83 * call gsahit (1, 4, 1, lnums(1), xm, ihit) ! store the hit
84 **************************************************************************************
85 cdaq 1.1 *UUU
86 ****
87 elseif (SDC_PLANE_NUM(chamhit) .EQ. 2) then
88 nlevel = 0 ! initial value for # of levels
89 lnames(1) = 'WCHA' ! level one
90 lnums(1) = 1 ! copy one, higher chamber
91 lnames(2) = 'WABU' ! U plane
92 lnums(2) = 1 ! copy one
93 wirenum = nint(sdc_nrwire(SDC_PLANE_NUM(chamhit))) + 1
94 & - SDC_WIRE_NUM(chamhit)
95 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
96 & wirenum = SDC_WIRE_NUM(chamhit)
97 if (wirenum .le. 24) write(wire,'(a,a,a,a)') 'AUC',char(64 + wirenum)
98 if (wirenum .gt. 24) write(wire,'(a,a,a,a)') 'AUD',char(64 - 24 + wirenum)
99 lnames(3) = wire ! U wires
100 lnums(3) = wirenum ! wire number
101 call glvolu (4, lnames, lnums, error_code)
102 call gdtom (xd, xm, 1) ! transform from detector to MARS
103 call gsatt (wire,'SEEN',1)
104 call gsatt (wire,'COLO',13)
105 * call gsahit (1, 4, 1, lnums(1), xm, ihit) ! store the hit
106 cdaq 1.1 **************************************************************************************
107 *VVV
108 ****
109 elseif (SDC_PLANE_NUM(chamhit) .EQ. 3) then
110 nlevel = 0 ! initial value for # of levels
111 lnames(1) = 'WCHA' ! level one
112 lnums(1) = 1 ! copy one, higher chamber
113 lnames(2) = 'WAAX' ! X plane
114 lnums(2) = 1 ! copy one
115 wirenum = nint(SDC_nrwire(SDC_PLANE_NUM(chamhit))) + 1
116 & - SDC_WIRE_NUM(chamhit)
117 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
118 & wirenum = SDC_WIRE_NUM(chamhit)
119 if (wirenum .le. 16) write(wire,'(a,a,a,a)') 'AXA',char(64 + wirenum)
120 if ((wirenum .gt. 16) .and. (wirenum .le. 32)) write(wire,'(a,a,a,a)')
121 $ 'AXB',char(64 - 16 + wirenum)
122 if ((wirenum .gt. 32) .and. (wirenum .le. 48)) write(wire,'(a,a,a,a)')
123 $ 'AXC',char(64 - 32 + wirenum)
124 if ((wirenum .gt. 48) .and. (wirenum .le. 64)) write(wire,'(a,a,a,a)')
125 $ 'AXD',char(64 - 48 + wirenum)
126 lnames(3) = wire
127 cdaq 1.1 lnums(3) = wirenum ! wire number
128 call glvolu (4, lnames, lnums, error_code)
129 call gdtom (xd, xm, 1) ! transform from detector to MARS
130 call gsatt (wire,'SEEN',1)
131 call gsatt (wire,'COLO',13)
132 * call gsahit (1, 6, 1, lnums(1), xm, ihit) ! store the hit
133 **************************************************************************************
134 *VVV
135 ****
136 elseif (SDC_PLANE_NUM(chamhit) .EQ. 4) then
137 nlevel = 0 ! initial value for # of levels
138 lnames(1) = 'WCHA' ! level one
139 lnums(1) = 1 ! copy one, higher chamber
140 lnames(2) = 'WABX' ! X plane
141 lnums(2) = 1 ! copy one
142 wirenum = nint(SDC_nrwire(SDC_PLANE_NUM(chamhit))) + 1
143 & - SDC_WIRE_NUM(chamhit)
144 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
145 & wirenum = SDC_WIRE_NUM(chamhit)
146 if (wirenum .le. 16) write(wire,'(a,a,a,a)') 'AXE',char(64 +
147 $ wirenum)
148 cdaq 1.1 if ((wirenum .gt. 16) .and. (wirenum .le. 32)) write(wire
149 $ ,'(a,a,a,a)')'AXF',char(64 - 16 + wirenum)
150 if ((wirenum .gt. 32) .and. (wirenum .le. 48)) write(wire
151 $ ,'(a,a,a,a)')'AXG',char(64 - 32 + wirenum)
152 if ((wirenum .gt. 48) .and. (wirenum .le. 64)) write(wire
153 $ ,'(a,a,a,a)')'AXH',char(64 - 48 + wirenum)
154 lnames(3) = wire
155 lnums(3) = wirenum ! wire number
156 call glvolu (4, lnames, lnums, error_code)
157 call gdtom (xd, xm, 1) ! transform from detector to MARS
158 call gsatt (wire,'SEEN',1)
159 call gsatt (wire,'COLO',13)
160 * call gsahit (1, 6, 1, lnums(1), xm, ihit) ! store the hit
161 **************************************************************************************
162 *XXX
163 ****
164 elseif (SDC_PLANE_NUM(chamhit) .EQ. 5) then
165 nlevel = 0 ! initial value for # of levels
166 lnames(1) = 'WCHA' ! level one
167 lnums(1) = 1 ! copy one, higher chamber
168 lnames(2) = 'WAAV' ! V plane
169 cdaq 1.1 lnums(2) = 1 ! copy one
170 wirenum = nint(SDC_nrwire(SDC_PLANE_NUM(chamhit))) + 1
171 & - SDC_WIRE_NUM(chamhit)
172 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
173 & wirenum = SDC_WIRE_NUM(chamhit)
174 if (wirenum .le. 24) write(wire,'(a,a,a,a)') 'AVA',char(64 +
175 $ wirenum)
176 if (wirenum .gt. 24) write(wire,'(a,a,a,a)') 'AVB',char(64 - 24
177 $ + wirenum)
178 lnames(3) = wire ! V wires
179 lnums(3) = wirenum ! wire number
180 call glvolu (4, lnames, lnums, error_code)
181 call gdtom (xd, xm, 1) ! transform from detector to MARS
182 call gsatt (wire,'SEEN',1)
183 call gsatt (wire,'COLO',13)
184 * call gsahit (1, 5, 1, lnums(1), xm, ihit) ! store the hit
185 * call gsahit (1, 90, 1, lnums(1), xm, ihit) ! store the hit
186 **************************************************************************************
187 *XXX
188 ****
189 elseif (SDC_PLANE_NUM(chamhit) .EQ. 6) then
190 cdaq 1.1 nlevel = 0 ! initial value for # of levels
191 lnames(1) = 'WCHA' ! level one
192 lnums(1) = 1 ! copy one, higher chamber
193 lnames(2) = 'WABV' ! V plane
194 lnums(2) = 1 ! copy one
195 wirenum = nint(SDC_nrwire(SDC_PLANE_NUM(chamhit))) + 1
196 & - SDC_WIRE_NUM(chamhit)
197 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
198 & wirenum = SDC_WIRE_NUM(chamhit)
199 if (wirenum .le. 24) write(wire,'(a,a,a,a)') 'AVC',char(64 +
200 $ wirenum)
201 if (wirenum .gt. 24) write(wire,'(a,a,a,a)') 'AVD',char(64 - 24
202 $ + wirenum)
203 lnames(3) = wire ! V wires
204 lnums(3) = wirenum ! wire number
205 call glvolu (4, lnames, lnums, error_code)
206 call gdtom (xd, xm, 1) ! transform from detector to MARS
207 call gsatt (wire,'SEEN',1)
208 call gsatt (wire,'COLO',13)
209 * call gsahit (1, 5, 1, lnums(1), xm, ihit) ! store the hit
210 * call gsahit (1, 90, 1, lnums(1), xm, ihit) ! store the hit
211 cdaq 1.1 **************************************************************************************
212 **************************************************************************************
213 *UUU
214 ****
215 elseif (SDC_PLANE_NUM(chamhit) .EQ. 7) then
216 nlevel = 0 ! initial value for # of levels
217 lnames(1) = 'WCHB' ! level one
218 lnums(1) = 1 ! copy one, higher chamber
219 lnames(2) = 'WBAU' ! U plane
220 lnums(2) = 1 ! copy one
221 wirenum = nint(sdc_nrwire(SDC_PLANE_NUM(chamhit))) + 1
222 & - SDC_WIRE_NUM(chamhit)
223 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
224 & wirenum = SDC_WIRE_NUM(chamhit)
225 if (wirenum .le. 24) write(wire,'(a,a,a,a)') 'BUA',char(64 +
226 $ wirenum)
227 if (wirenum .gt. 24) write(wire,'(a,a,a,a)') 'BUB',char(64 - 24
228 $ + wirenum)
229 lnames(3) = wire ! U wires
230 lnums(3) = wirenum ! wire number
231 call glvolu (4, lnames, lnums, error_code)
232 cdaq 1.1 call gdtom (xd, xm, 1) ! transform from detector to MARS
233 call gsatt (wire,'SEEN',1)
234 call gsatt (wire,'COLO',15)
235 * call gsahit (1, 4, 1, lnums(1), xm, ihit) ! store the hit
236 **************************************************************************************
237 *UUU
238 ****
239 elseif (SDC_PLANE_NUM(chamhit) .EQ. 8) then
240 nlevel = 0 ! initial value for # of levels
241 lnames(1) = 'WCHB' ! level one
242 lnums(1) = 1 ! copy one, higher chamber
243 lnames(2) = 'WBBU' ! U plane
244 lnums(2) = 1 ! copy one
245 wirenum = nint(sdc_nrwire(SDC_PLANE_NUM(chamhit))) + 1
246 & - SDC_WIRE_NUM(chamhit)
247 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
248 & wirenum = SDC_WIRE_NUM(chamhit)
249 if (wirenum .le. 24) write(wire,'(a,a,a,a)') 'BUC',char(64 +
250 $ wirenum)
251 if (wirenum .gt. 24) write(wire,'(a,a,a,a)') 'BUD',char(64 - 24
252 $ + wirenum)
253 cdaq 1.1 lnames(3) = wire ! U wires
254 lnums(3) = wirenum ! wire number
255 call glvolu (4, lnames, lnums, error_code)
256 call gdtom (xd, xm, 1) ! transform from detector to MARS
257 call gsatt (wire,'SEEN',1)
258 call gsatt (wire,'COLO',15)
259 * call gsahit (1, 4, 1, lnums(1), xm, ihit) ! store the hit
260 **************************************************************************************
261 *VVV
262 ****
263 elseif (SDC_PLANE_NUM(chamhit) .EQ. 9) then
264 nlevel = 0 ! initial value for # of levels
265 lnames(1) = 'WCHB' ! level one
266 lnums(1) = 1 ! copy one, higher chamber
267 lnames(2) = 'WBAX' ! X plane
268 lnums(2) = 1 ! copy one
269 wirenum = nint(SDC_nrwire(SDC_PLANE_NUM(chamhit))) + 1
270 & - SDC_WIRE_NUM(chamhit)
271 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
272 & wirenum = SDC_WIRE_NUM(chamhit)
273 if (wirenum .le. 16) write(wire,'(a,a,a,a)') 'BXA',char(64 +
274 cdaq 1.1 $ wirenum)
275 if ((wirenum .gt. 16) .and. (wirenum .le. 32)) write(wire
276 $ ,'(a,a,a,a)')'BXB',char(64 - 16 + wirenum)
277 if ((wirenum .gt. 32) .and. (wirenum .le. 48)) write(wire
278 $ ,'(a,a,a,a)')'BXC',char(64 - 32 + wirenum)
279 if ((wirenum .gt. 48) .and. (wirenum .le. 64)) write(wire
280 $ ,'(a,a,a,a)')'BXD',char(64 - 48 + wirenum)
281 lnames(3) = wire
282 lnums(3) = wirenum ! wire number
283 call glvolu (4, lnames, lnums, error_code)
284 call gdtom (xd, xm, 1) ! transform from detector to MARS
285 call gsatt (wire,'SEEN',1)
286 call gsatt (wire,'COLO',15)
287 * call gsahit (1, 6, 1, lnums(1), xm, ihit) ! store the hit
288 **************************************************************************************
289 *VVV
290 ****
291 elseif (SDC_PLANE_NUM(chamhit) .EQ. 10) then
292 nlevel = 0 ! initial value for # of levels
293 lnames(1) = 'WCHB' ! level one
294 lnums(1) = 1 ! copy one, higher chamber
295 cdaq 1.1 lnames(2) = 'WBBX' ! X plane
296 lnums(2) = 1 ! copy one
297 wirenum = nint(SDC_nrwire(SDC_PLANE_NUM(chamhit))) + 1
298 & - SDC_WIRE_NUM(chamhit)
299 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
300 & wirenum = SDC_WIRE_NUM(chamhit)
301 if (wirenum .le. 16) write(wire,'(a,a,a,a)') 'BXE',char(64 +
302 $ wirenum)
303 if ((wirenum .gt. 16) .and. (wirenum .le. 32)) write(wire
304 $ ,'(a,a,a,a)')'BXF',char(64 - 16 + wirenum)
305 if ((wirenum .gt. 32) .and. (wirenum .le. 48)) write(wire
306 $ ,'(a,a,a,a)')'BXG',char(64 - 32 + wirenum)
307 if ((wirenum .gt. 48) .and. (wirenum .le. 64)) write(wire
308 $ ,'(a,a,a,a)')'BXH',char(64 - 48 + wirenum)
309 lnames(3) = wire
310 lnums(3) = wirenum ! wire number
311 call glvolu (4, lnames, lnums, error_code)
312 call gdtom (xd, xm, 1) ! transform from detector to MARS
313 call gsatt (wire,'SEEN',1)
314 call gsatt (wire,'COLO',15)
315 * call gsahit (1, 6, 1, lnums(1), xm, ihit) ! store the hit
316 cdaq 1.1 **************************************************************************************
317 *XXX
318 ****
319 elseif (SDC_PLANE_NUM(chamhit) .EQ. 11) then
320 nlevel = 0 ! initial value for # of levels
321 lnames(1) = 'WCHB' ! level one
322 lnums(1) = 1 ! copy one, higher chamber
323 lnames(2) = 'WBAV' ! V plane
324 lnums(2) = 1 ! copy one
325 wirenum = nint(SDC_nrwire(SDC_PLANE_NUM(chamhit))) + 1
326 & - SDC_WIRE_NUM(chamhit)
327 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
328 & wirenum = SDC_WIRE_NUM(chamhit)
329 if (wirenum .le. 24) write(wire,'(a,a,a,a)') 'BVA',char(64 +
330 $ wirenum)
331 if (wirenum .gt. 24) write(wire,'(a,a,a,a)') 'BVB',char(64 - 24
332 $ + wirenum)
333 lnames(3) = wire ! V wires
334 lnums(3) = wirenum ! wire number
335 call glvolu (4, lnames, lnums, error_code)
336 call gdtom (xd, xm, 1) ! transform from detector to MARS
337 cdaq 1.1 call gsatt (wire,'SEEN',1)
338 call gsatt (wire,'COLO',15)
339 * call gsahit (1, 5, 1, lnums(1), xm, ihit) ! store the hit
340 * call gsahit (1, 90, 1, lnums(1), xm, ihit) ! store the hit
341 **************************************************************************************
342 *XXX
343 ****
344 elseif (SDC_PLANE_NUM(chamhit) .EQ. 12) then
345 nlevel = 0 ! initial value for # of levels
346 lnames(1) = 'WCHB' ! level one
347 lnums(1) = 1 ! copy one, higher chamber
348 lnames(2) = 'WBBV' ! V plane
349 lnums(2) = 1 ! copy one
350 wirenum = nint(SDC_nrwire(SDC_PLANE_NUM(chamhit))) + 1
351 & - SDC_WIRE_NUM(chamhit)
352 if (SDC_WIRE_COUNTING(SDC_PLANE_NUM(chamhit)) .EQ. 1)
353 & wirenum = SDC_WIRE_NUM(chamhit)
354 if (wirenum .le. 24) write(wire,'(a,a,a,a)') 'BVC',char(64 +
355 $ wirenum)
356 if (wirenum .gt. 24) write(wire,'(a,a,a,a)') 'BVD',char(64 - 24
357 $ + wirenum)
358 cdaq 1.1 lnames(3) = wire ! V wires
359 lnums(3) = wirenum ! wire number
360 call glvolu (4, lnames, lnums, error_code)
361 call gdtom (xd, xm, 1) ! transform from detector to MARS
362 call gsatt (wire,'SEEN',1)
363 call gsatt (wire,'COLO',15)
364 * call gsahit (1, 5, 1, lnums(1), xm, ihit) ! store the hit
365 * call gsahit (1, 90, 1, lnums(1), xm, ihit) ! store the hit
366 **************************************************************************************
367 endif
368 enddo
369 endif
370
371 * Take a look at the hodoscopes
372 * See the file "displaynumbering.help" for a description of the numbering of the
373 * various detector elements
374 *
375 if (SSCIN_TOT_HITS .GT. 0) then
376 lnames(0) = 'SHUT' ! relative to the hut
377 lnums(0) = 1 ! copy 1
378 do scinhit = 1, SSCIN_TOT_HITS
379 cdaq 1.1 *
380 * First the lower X
381 *
382 if (SSCIN_PLANE_NUM(scinhit) .EQ. 1) then
383 nlevel = 0 ! initial value for # of levels
384 lnames(1) = 'HOD1' ! level one
385 lnums(1) = 1 ! copy one, lower hodo
386 lnames(2) = 'HDX1' ! X strips
387 lnums(2) = 1 ! copy one
388 write (scinname,'(a,a)') 'H1X',char(64 + SSCIN_COUNTER_NUM(scinhit))
389 lnames(3) = scinname ! X strips
390 lnums(3) = SSCIN_COUNTER_NUM(scinhit) ! X strip number
391 call glvolu (4, lnames, lnums, error_code)
392 call gdtom (xd, xm, 1) ! transform from detector to MARS
393 * call gsahit (1, 2, 1, lnums(1), xm, ihit) ! store the hit
394 call gsatt (scinname,'COLO',14) !change the color of the it element
395 call gsatt (scinname,'FILL',5)
396 call gsatt (scinname,'LWID',1)
397 *
398 * now the upper X
399 *
400 cdaq 1.1 elseif (SSCIN_PLANE_NUM(scinhit) .EQ. 3) then
401 nlevel = 0 ! initial value for # of levels
402 lnames(1) = 'HOD2' ! level one
403 lnums(1) = 1 ! copy two, upper hodo
404 lnames(2) = 'HDX2' ! X strips
405 lnums(2) = 1 ! copy one
406 write (scinname,'(a,a)') 'H2X',char(64 + SSCIN_COUNTER_NUM(scinhit))
407 lnames(3) = scinname ! X strips
408 lnums(3) = SSCIN_COUNTER_NUM(scinhit) ! X strip number
409 call glvolu (4, lnames, lnums, error_code)
410 call gdtom (xd, xm, 1) ! transform from detector to MARS
411 * call gsahit (1, 2, 1, lnums(1), xm, ihit) ! store the hit
412 call gsatt (scinname,'COLO',14) !change the color of the it element
413 call gsatt (scinname,'FILL',5)
414 call gsatt (scinname,'LWID',1)
415 *
416 * now the lower Y
417 *
418 elseif (SSCIN_PLANE_NUM(scinhit) .EQ. 2) then
419 nlevel = 0 ! initial value for # of levels
420 lnames(1) = 'HOD1'
421 cdaq 1.1 lnums(1) = 1 ! copy one, lower hodo
422 lnames(2) = 'HDY1' ! Y strips
423 lnums(2) = 1 ! copy one
424 write (scinname,'(a,a)') 'H1Y',char(64 + SSCIN_COUNTER_NUM(scinhit))
425 lnames(3) = scinname ! Y strips
426 lnums(3) = SSCIN_COUNTER_NUM(scinhit) ! Y strip number
427 call glvolu (4, lnames, lnums, error_code)
428 call gdtom (xd, xm, 1) ! transform from detector to MARS
429 * call gsahit (1, 3, 1, lnums(1), xm, ihit) ! store the hit
430 call gsatt (scinname,'COLO',14) !change the color of the it element
431 call gsatt (scinname,'FILL',5)
432 call gsatt (scinname,'LWID',1)
433 *
434 * now the upper Y
435 *
436 elseif (SSCIN_PLANE_NUM(scinhit) .EQ. 4) then
437 nlevel = 0 ! initial value for # of levels
438 lnames(1) = 'HOD2'
439 lnums(1) = 1 ! copy two, upper hodo
440 lnames(2) = 'HDY2' ! Y strips
441 lnums(2) = 1 ! copy one
442 cdaq 1.1 write (scinname,'(a,a)') 'H2Y',char(64 + SSCIN_COUNTER_NUM(scinhit))
443 lnames(3) = scinname ! Y strips
444 lnums(3) = SSCIN_COUNTER_NUM(scinhit) ! Y strip number
445 call glvolu (4, lnames, lnums, error_code)
446 call gdtom (xd, xm, 1) ! transform from detector to MARS
447 * call gsahit (1, 3, 1, lnums(1), xm, ihit) ! store the hit
448 call gsatt (scinname,'COLO',14) !change the color of the it element
449 call gsatt (scinname,'FILL',5)
450 call gsatt (scinname,'LWID',1)
451 endif
452 enddo
453 endif
454 *
455 * Now take care of the shower detector
456 * See the file "displaynumbering.help" for a description of the numbering of the
457 * various detector elements
458 *
459 lnames(0) = 'SHUT'
460 lnums(0) = 1
461 if (SCAL_NUM_HITS .GE. 0) then
462 do showhit = 1, SCAL_NUM_HITS
463 cdaq 1.1 nlevel = 0
464 lnames(1) = 'SHOW' ! shower detector
465 lnums(1) = 4 ! copy 1
466 write(layername,'(a,i1)') 'LAY',SCAL_COLS(showhit)
467 lnames(2) = layername ! x subdivisions
468 lnums(2) = 11
469 lnums(3) = 1
470 write (blockname,'(a,i1,a)') 'BL',SCAL_COLS(showhit),
471 $ char(64 + scal_rows(showhit))
472 lnames(3) = blockname ! z subdivisions
473 call glvolu(4, lnames, lnums, error_code)
474 call gdtom (xd, xm, 1) ! transform from det to MARS
475 call gsatt (blockname,'COLO',14) !change the color of the it element
476 call gsatt (blockname,'FILL',5)
477 call gsatt (blockname,'LWID',2)
478 enddo
479 endif
480 end
|
Return to
s_one_ev_generate.f
CVS log
Up to [HallC] / Analyzer / ONEEV