Analyzer/ONEEV/s_one_ev_generate.f - annotate

Return to s_one_ev_generate.f CVS log

Up to [HallC] / Analyzer / ONEEV

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

Analyzer/Replay: Mark Jones, Documents: Stephen Wood