Analyzer/ONEEV/h_one_ev_generate.f - annotate

Return to h_one_ev_generate.f CVS log

Up to [HallC] / Analyzer / ONEEV

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

Analyzer/Replay: Mark Jones, Documents: Stephen Wood