geant_gep/src/ugeom.f - annotate

Return to ugeom.f CVS log

Up to [HallC] / geant_gep / src

1 jones 1.1 subroutine ugeom 2 c 3 c define experimental setup. write for cebaf HALL a fpp. 4 c august 17, 1994 - e.j. brash, rutgers. 5 c 6 implicit none 7 c 8 include 'fpp_local.h' 9 include 'geant_local.h' 10 c 11 c include 'parameter.h' 12 c include 'espace_type.h' 13 c include 'detector.h' 14 c include 'transport.h' 15 c include 'experiment.h' 16 c include 'option.h' 17 c 18 integer nHALL,iv_HALL,irot,irotnull,irotx,irotu,irotv,iv_targ 19 integer nair,ncarbon,naira,nairb,nairc,naird
20 brash 1.3 integer naire, nairf, nairg, nairh, nairi 21 integer nsci1, nsci2 ,nhch1,nhch2
22 jones 1.2 integer nfch1,nfch2,nfch3,nfch4,nanl1,nanl2
23 brash 1.6 integer nch2,nsci,nanalyz,nhy,ncarbo
24 jones 1.2 integer nt_ch2, nt_sci, nt_analyz
25 jones 1.1 c 26 character*4 chnmsv(1),chnamh(6) 27 c 28 c variables used in calls to gstmed (which defines tracking material 29 c parameters) 30
31 jones 1.2 integer nt_air,nt_carbon, ic, irot1, nt_anll, nt_anl2 32 integer ndim,nvac 33 integer isvol,ifield,nwbuf
34 jones 1.1 real fieldm,tmaxfd,dmaxms,deemax,epsil,stmin,ubuf(10)
35 jones 1.2 real rotch1(6) 36 real zhch1,zhch2
37 brash 1.3 real zsci1, zsci2 ,zanl1,zfch1,zfch2,zanl2,zfch3,zfch4
38 jones 1.1 real zaira, zairb, zairc, zaird
39 jones 1.2 real zaire, zairf, zairg, zairh
40 brash 1.3 real zairi
41 jones 1.1 c 42 common / gugeompar / irot, irotnull 43 c
44 brash 1.3 c *ADD FOR SCI2 AND AIRI??*
45 jones 1.1 parameter (ndim=3) 46 parameter (nair=15) 47 parameter (nvac=15) 48 parameter (nHALL=100) 49 parameter (ncarbon=6) 50 parameter (naira=602) 51 parameter (nairb=603) 52 parameter (nairc=604) 53 parameter (naird=605)
54 jones 1.2 parameter (naire=606) 55 parameter (nairf=607) 56 parameter (nairg=608) 57 parameter (nairh=609)
58 jones 1.1 parameter (nsci1=616)
59 jones 1.2 parameter (nhch1=617) 60 parameter (nhch2=618) 61 parameter (nfch1=619) 62 parameter (nfch2=620) 63 parameter (nfch3=621) 64 parameter (nfch4=622) 65 parameter (nch2=625)
66 jones 1.1 parameter (nsci=626)
67 brash 1.6 parameter (nhy=627) 68 parameter (ncarbo=628)
69 jones 1.1 70 real HALL_size(3) 71 real aira_size(3),airb_size(3),airc_size(3),aird_size(3)
72 jones 1.2 real aire_size(3),airf_size(3),airg_size(3),airh_size(3)
73 brash 1.3 real airi_size(3)
74 jones 1.2 real sci1_size(3),hch1_size(3),hch2_size(3),anl1_size(3)
75 brash 1.3 real sci2_size(3)
76 jones 1.2 real anl2_size(3),fch1_size(3),fch2_size(3),fch3_size(3) 77 real fch4_size(3)
78 jones 1.1 real nul_rot(6) 79 real rotx(6) 80 real rotu(6) 81 real rotv(6) 82 real theta(3),phi(3),rowmat(3) 83 real sinth,costh,sinph,cosph 84 real rotmat1, rtod 85 logical rotate 86 c 87 common/geomstep/rotmat1(3,3) 88 c 89 c --- scintillator NE-102A --- 90 real ane(2) /12.01,1.01/ 91 real zne(2) /6.,1./ 92 real wne(2) /1.,1.105/ 93 real dne /1.0320/ 94 c --- (CH2)2 --- 95 real achh(2) /12.01,1.01/ 96 real zchh(2) /6.,1./ 97 real wchh(2) /1.,2./
98 brash 1.6 real dchh /0.9350/
99 jones 1.1 c 100 c 101 integer ihset,ihdet,iset,idet,idtype,nvname,numbv 102 common/gcsets/ihset,ihdet,iset,idet,idtype,nvname,numbv(20) 103 integer nbitsv(1) /13/ 104 integer nbitsh(6) /5,6,16,16,18,18/ 105 real orig(6) /0.,0.,0.,0.,200.,0./ 106 real fact(6) /1.,1.,1.,100000.,500.,500./ 107 c 108 data chnmsv /'strw'/ 109 data chnamh /'ipla','nhip','strn','dist','ysva','zsva'/ 110 c 111 c 112 data HALL_size / 600., 600., 1000. / 113 data nul_rot/ 90.0, 0.0, 90.0, 90.0, 0.0, 0.0 / !null rotation 114 data rotx/ 180.0, 0.0, 90.0, 180.0, 90.0, 90.0 / !95 deg. rot for x-straws 115 data rotv/ 180.0, 0.0, 90.0, 135.0, 90.0, 45.0 / !-45 deg. rot for v-straws 116 data rotu/ 180.0, 0.0, 90.0, -135.0, 90.0, 135.0 / !45 deg. rot for u-straws 117 c 118 data rotch1/ 90.0, 0.0, 90.0, 90.0, 0.0, 0.0 / !ch1 rotation 119 c
120 brash 1.3 data hch1_size/75.00,60.00,8.5345/ 121 data aira_size/75.00,60.00,32.131/ 122 data hch2_size/75.00,60.00,8.5345/ 123 data airb_size/60.96,40.64,12.387/ 124 data sci1_size/60.96,40.64,0.50/ 125 data airc_size/60.96,40.64,9.297/ 126 data sci2_size/60.96,40.64,0.50/ 127 data aird_size/71.12,53.975,14.114/ 128 data anl1_size/71.12,53.975,27.94/ 129 data aire_size/83.0,67.0,2.542/ 130 data fch1_size/83.0,67.0,5.60/ 131 data airf_size/83.0,67.0,5.00/ 132 data fch2_size/83.0,67.0,5.60/ 133 data airg_size/71.12,53.975,2.277/ 134 data anl2_size/71.12,53.975,27.94/ 135 data airh_size/83.0,67.0,2.282/ 136 data fch3_size/83.0,67.0,5.60/ 137 data airi_size/83.0,67.0,5.00/ 138 data fch4_size/83.0,67.0,5.60/ 139 c 140 zhch1=-51.562
141 jones 1.2 zaira=zhch1+hch1_size(3)+aira_size(3) 142 zhch2=zaira+aira_size(3)+hch2_size(3) 143 zairb=zhch2+hch2_size(3)+airb_size(3) 144 zsci1=zairb+airb_size(3)+sci1_size(3) 145 zairc=zsci1+sci1_size(3)+airc_size(3)
146 brash 1.3 zsci2=zairc+airc_size(3)+sci2_size(3) 147 zaird=zsci2+sci2_size(3)+aird_size(3) 148 zanl1=zaird+aird_size(3)+anl1_size(3) 149 zaire=zanl1+anl1_size(3)+aire_size(3) 150 zfch1=zaire+aire_size(3)+fch1_size(3) 151 zairf=zfch1+fch1_size(3)+airf_size(3) 152 zfch2=zairf+airf_size(3)+fch2_size(3)
153 brash 1.4 zairg=zfch2+fch2_size(3)+airg_size(3)-0.1
154 brash 1.3 zanl2=zairg+airg_size(3)+anl2_size(3) 155 zairh=zanl2+anl2_size(3)+airh_size(3) 156 zfch3=zairh+airh_size(3)+fch3_size(3) 157 zairi=zfch3+fch3_size(3)+airi_size(3) 158 zfch4=zairi+airi_size(3)+fch4_size(3)
159 brash 1.4 c 160 c write(,)'Minimum airg position = ',(zairg-airg_size(3)) 161 c write(,)'Maximum fch2 position = ',(zfch2+fch2_size(3))
162 brash 1.3 c
163 jones 1.2 rtod=180.0/3.14159265
164 jones 1.1 c 165 rotmat1(1,1)=cos(psoff1)cos(thoff1)+sin(psoff1)sin(thoff1) 166 $ sin(phoff1) 167 rotmat1(1,2)=cos(psoff1)sin(thoff1)-sin(psoff1)cos(thoff1) 168 $ sin(phoff1) 169 rotmat1(1,3)=sin(psoff1)cos(phoff1) 170 rotmat1(2,1)=-cos(phoff1)sin(thoff1) 171 rotmat1(2,2)=cos(phoff1)cos(thoff1) 172 rotmat1(2,3)=sin(phoff1) 173 rotmat1(3,1)=-sin(psoff1)cos(thoff1)+cos(psoff1)sin(thoff1) 174 $ sin(phoff1) 175 rotmat1(3,2)=-sin(psoff1)sin(thoff1)-cos(psoff1)cos(thoff1) 176 $ sin(phoff1) 177 rotmat1(3,3)=cos(psoff1)cos(phoff1) 178 do ic=1,3 179 write(,)rotmat1(ic,1),rotmat1(ic,2),rotmat1(ic,3) 180 enddo 181 c 182 do ic=1,3 183 rowmat(1)=real(rotmat1(ic,1)) 184 rowmat(2)=real(rotmat1(ic,2)) 185 jones 1.1 rowmat(3)=real(rotmat1(ic,3)) 186 call gfang(rowmat,costh,sinth,cosph,sinph,rotate) 187 write(,)costh,sinth,cosph,sinph 188 if(rotate) then 189 if(costh.ne.0) then 190 theta(ic)=atan(sinth/costh)rtod 191 else 192 if(sinth.gt.0) then 193 theta(ic)=90.0 194 else if(sinth.lt.0) then 195 theta(ic)=-90.0 196 else 197 theta(ic)=0.0 198 endif 199 endif 200 if(cosph.ne.0) then 201 phi(ic)=atan(sinph/cosph)rtod 202 else 203 if(sinph.gt.0) then 204 phi(ic)=90.0 205 else if(sinph.lt.0) then 206 jones 1.1 phi(ic)=-90.0 207 else 208 phi(ic)=0.0 209 endif 210 endif 211 else 212 theta(ic)=0.0 213 phi(ic)=0.0 214 endif 215 write(6,)'fpp rotation 1 =',ic,theta(ic),phi(ic) 216 enddo 217 irot1=5 218 call gsrotm(irot1,theta(1),phi(1),theta(2), 219 & phi(2),theta(3),phi(3)) 220 c 221 c 222 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 223 c 224 c --- define the various mixtures for geant --- 225 c 226 write(6,)'defining mixtures now'
227 jones 1.2 call gsmixt(nch2,'chtwo$',achh,zchh,dchh,-2,wchh)
228 jones 1.1 call gsmixt(nsci,'scint$',ane,zne,dne,-2,wne) 229 c uncomment next line for density of hydrogen in (CH2)2
230 brash 1.6 call gsmate(nhy,'hydr$', 1.01, 1.0, 0.135, 865., 790.,0,0)
231 jones 1.1 c uncomment next line for normal density of carbon 232 c call gsmate(ncarbo,'carbo$',12.01,6.0, 2.265, 18.8, 80.,0,0) 233 c uncomment next line for density of carbon in (CH2)2
234 brash 1.6 call gsmate(ncarbo,'carbo$', 12.01,6.0, 0.800, 18.8, 80.,0,0)
235 jones 1.1 c 236 write(,)'Finished defining these materials' 237 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 238 c 239 c define the tracking medium parameters 240 c 241 nwbuf=10 242 c 243 c *** definition of tracking medium for air: 244 c 245 write(6,)'defining air medium now' 246 nt_air = nvac ! tracking medium # same as material # 247 isvol = 0 ! not sensitive 248 ifield = 0 ! no magnetic field 249 fieldm = 0.0 ! max field 250 tmaxfd = 0.3 ! maximum angle due to field (one step) in degrees 251 dmaxms = 0.5 ! max disp. due to mulsct. in one step (cm) 252 deemax = 0.2 ! max fractional energy loss in one step 253 epsil = 0.01 ! tracking precision (cm) 254 stmin = 0.01 ! min step due to e loss or mulsct. (cm) 255 ubuf(1)= 0. ! tracking stop switch 256 jones 1.1 write(6,)'calling gstmed' 257 call gstmed(nt_air,'HALL$',nvac,isvol,ifield,fieldm,tmaxfd, 258 1 dmaxms,deemax,epsil,stmin,ubuf,nwbuf) 259 write(6,)'back from gstmed' 260 c 261 c ** definition of tracking medium for carbon: 262 c
263 brash 1.5 write(6,*)'defining carbon medium now' 264 nt_carbon = ncarbon ! tracking medium # same as material # 265 isvol = 0 ! not sensitive 266 ifield = 0 ! no magnetic field 267 fieldm = 0.0 ! max field 268 tmaxfd = 0.3 ! maximum angle due to field (one step) in degrees 269 dmaxms = 0.5 ! max disp. due to mulsct. in one step (cm) 270 deemax = 0.2 ! max fractional energy loss in one step 271 epsil = 0.01 ! tracking precision (cm) 272 stmin = 0.01 ! min step due to e loss or mulsct. (cm) 273 ubuf(1)= 0. ! tracking stop switch
274 jones 1.2 c write(6,*)'calling gstmed'
275 brash 1.5 call gstmed(nt_carbon,'HALL$',ncarbon,isvol,ifield,fieldm,tmaxfd, 276 1 dmaxms,deemax,epsil,stmin,ubuf,nwbuf)
277 jones 1.2 c write(6,*)'back from gstmed'
278 jones 1.1 c 279 c * definition of tracking medium for magnet: 280 c 281 c nt_mag = nmag ! tracking medium # same as material number 282 c isvol = 0 ! not sensitive 283 c ifield = 2 ! magnetic field defined in gufld.for - helix tracking 284 c fieldm = 20.0 ! max field 285 c tmaxfd = 0.3 ! maximum angle due to field (one step) in degrees 286 c dmaxms = 0.5 ! max disp. due to mulsct. in one step (cm) 287 c deemax = 0.2 ! max fractional energy loss in one step 288 c epsil = 0.01 ! tracking precision (cm) 289 c stmin = 0.01 ! min step due to e loss or mulsct. (cm) 290 c ubuf(1)= 0. ! tracking stop switch 291 c call gstmed(nt_mag,'magnet$',nvac,isvol,ifield,fieldm,tmaxfd, 292 c 1 dmaxms,deemax,epsil,stmin,ubuf,nwbuf) 293 c 294 c * definition of tracking medium for pb shielding: 295 c 296 c nt_pb = npb ! tracking medium # same as material # 297 c isvol = 1 ! sensitive 298 c ifield = 0 ! no magnetic field 299 jones 1.1 c fieldm = 0.0 ! max field 300 c tmaxfd = 0.3 ! maximum angle due to field (one step) in degrees 301 c dmaxms = 0.5 ! max disp. due to mulsct. in one step (cm) 302 c deemax = 0.2 ! max fractional energy loss in one step 303 c epsil = 0.01 ! tracking precision (cm) 304 c stmin = 0.01 ! min step due to e loss or mulsct. (cm) 305 c ubuf(1)= 0. ! tracking stop switch 306 c call gstmed(nt_pb,'HALL$',npb,isvol,ifield,fieldm,tmaxfd, 307 c 1 dmaxms,deemax,epsil,stmin,ubuf,nwbuf) 308 c 309 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 310 c 311 c *** definition of tracking medium for analyzer: 312 c 313 nt_analyz = 630 ! Choose Arbitrary Tracking Medium Number for Analyzer 314 isvol = 1 ! sensitive 315 ifield = 0 ! no magnetic field 316 fieldm = 0.0 ! max field 317 tmaxfd = 0.3 ! maximum angle due to field (one step) in degrees 318 dmaxms = 1.0 ! max disp. due to mulsct. in one step (cm) 319 deemax = 0.1 ! max fractional energy loss in one step 320 jones 1.1 epsil = 0.01 ! tracking precision (cm) 321 stmin = 0.05 ! min step due to e loss or mulsct. (cm) 322 ubuf(1)= 0. ! tracking stop switch 323 c
324 brash 1.5 c nanalyz = ncarbon
325 brash 1.6 c nanalyz = nhy
326 brash 1.8 c nanalyz = ncarbo 327 nanalyz = nch2
328 jones 1.1 call gstmed(nt_analyz,'HALL$',nanalyz,isvol,ifield,fieldm,tmaxfd, 329 1 dmaxms,deemax,epsil,stmin,ubuf,nwbuf) 330 c
331 jones 1.2 nt_ch2 = nch2 ! tracking medium # same as material # 332 c 333 c *** definition of tracking medium for scintillator: 334 c
335 jones 1.1 nt_sci = nsci ! tracking medium # same as material #
336 jones 1.2 isvol = 1 ! sensitive 337 ifield = 0 ! no magnetic field 338 fieldm = 0.0 ! max field 339 tmaxfd = 0.3 ! maximum angle due to field (one step) in degrees 340 dmaxms = 1.0 ! max disp. due to mulsct. in one step (cm) 341 deemax = 0.1 ! max fractional energy loss in one step 342 epsil = 0.01 ! tracking precision (cm) 343 stmin = 0.05 ! min step due to e loss or mulsct. (cm) 344 ubuf(1)= 0. ! tracking stop switch 345 c 346 call gstmed(nt_sci,'HALL$',nsci,isvol,ifield,fieldm,tmaxfd, 347 1 dmaxms,deemax,epsil,stmin,ubuf,nwbuf) 348 c 349
350 jones 1.1 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 351 c 352 c print the tracking media parameters 353 c 354 write(6,)'printing tracking media params now' 355 call gptmed ( 0 ) 356 c 357 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 358 c 359 c the mother volume will be the HALL volume, it is filled with air 360 c 361 write(6,)'defining volumes now' 362 write(6,)'defining HALL now' 363 call gsvolu ( 'HALL', 'BOX ', nair, HALL_size, ndim, iv_HALL ) 364 c 365 if ( iv_HALL.le.0 ) then 366 write ( 6, ) ' ugeom: error, iv_HALL=',iv_HALL 367 write ( 6,* ) ' HALL geometry setup failed' 368 stop 369 end if 370 c 371 jones 1.1 c we do not see the HALL volume in the pictures 372 c 373 call gsatt ( 'HALL', 'SEEN', 0 ) 374 c 375 c define the null rotation 376 c 377 write(6,)'defining null rot now' 378 irot = 1 379 call gsrotm(irot,nul_rot(1),nul_rot(2),nul_rot(3), 380 x nul_rot(4),nul_rot(5),nul_rot(6) ) 381 irotnull = irot 382 c 383 c define the rotation necessary to position the x-straws 384 c 385 write(6,)'defining rotx now' 386 irotx = 2 387 call gsrotm(irotx,rotx(1),rotx(2),rotx(3), 388 x rotx(4),rotx(5),rotx(6) ) 389 c 390 c 391 c define the rotation necessary to position the u-straws 392 jones 1.1 c 393 write(6,)'defining rotu now' 394 irotu = 3 395 call gsrotm(irotu,rotu(1),rotu(2),rotu(3), 396 x rotu(4),rotu(5),rotu(6) ) 397 c 398 c 399 c define the rotation necessary to position the v-straws 400 c 401 write(6,)'defining rotv now' 402 irotv = 4 403 call gsrotm(irotv,rotv(1),rotv(2),rotv(3), 404 x rotv(4),rotv(5),rotv(6) ) 405 c 406 c
407 jones 1.2 write(6,)'defining hch1 volume now' 408 call gsvolu ( 'hch1', 'BOX ', nt_air, 409 x hch1_size, ndim, iv_targ ) 410 c 411 if ( iv_targ.le.0 ) then 412 write ( 6, ) ' ugeom: error, iv_targ=',iv_targ 413 write ( 6,* ) ' hch1 geometry setup failed' 414 stop 415 end if 416 c 417 c
418 jones 1.1 write(6,)'defining aira volume now' 419 call gsvolu ( 'aira', 'BOX ', nt_air, 420 x aira_size, ndim, iv_targ ) 421 c 422 if ( iv_targ.le.0 ) then 423 write ( 6, ) ' ugeom: error, iv_targ=',iv_targ 424 write ( 6,* ) ' aira geometry setup failed' 425 stop 426 end if 427 c 428 c
429 jones 1.2 write(6,)'defining hch2 volume now' 430 call gsvolu ( 'hch2', 'BOX ', nt_air, 431 x hch2_size, ndim, iv_targ ) 432 c 433 if ( iv_targ.le.0 ) then 434 write ( 6, ) ' ugeom: error, iv_targ=',iv_targ 435 write ( 6,* ) ' hch2 geometry setup failed' 436 stop 437 end if 438 c 439 c
440 jones 1.1 write(6,)'defining airb volume now' 441 call gsvolu ( 'airb', 'BOX ', nt_air, 442 x airb_size, ndim, iv_targ ) 443 c 444 if ( iv_targ.le.0 ) then 445 write ( 6, ) ' ugeom: error, iv_targ=',iv_targ 446 write ( 6,* ) ' airb geometry setup failed' 447 stop 448 end if 449 c 450 c
451 jones 1.2 write(6,)'defining scintillator now' 452 call gsvolu ( 'sci1', 'BOX ', nt_sci, 453 x sci1_size, ndim, iv_targ ) 454 c 455 write(6,)iv_targ 456 if ( iv_targ.le.0 ) then 457 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ 458 write ( 6,* ) ' sci1 geometry setup failed' 459 stop 460 end if 461 462 c 463 c
464 jones 1.1 write(6,)'defining airc volume now' 465 call gsvolu ( 'airc', 'BOX ', nt_air, 466 x airc_size, ndim, iv_targ ) 467 c 468 if ( iv_targ.le.0 ) then 469 write ( 6, ) ' ugeom: error, iv_targ=',iv_targ 470 write ( 6,* ) ' airc geometry setup failed' 471 stop 472 end if 473 c
474 brash 1.3 c 475 write(6,)'defining the second scintillator now' 476 call gsvolu ( 'sci2', 'BOX ', nt_sci, 477 x sci2_size, ndim, iv_targ ) 478 c 479 write(6,)iv_targ 480 if ( iv_targ.le.0 ) then 481 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ 482 write ( 6,* ) ' sci2 geometry setup failed' 483 stop 484 end if 485 c 486 c 487 write(6,)'defining aird volume now' 488 call gsvolu ( 'aird', 'BOX ', nt_air, 489 x aird_size, ndim, iv_targ ) 490 c 491 if ( iv_targ.le.0 ) then 492 write ( 6, ) ' ugeom: error, iv_targ=',iv_targ 493 write ( 6,* ) ' aird geometry setup failed' 494 stop 495 brash 1.3 end if 496 c
497 jones 1.2 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 498 c 499 write(6,)'DEFINING THE FIRST ANALYZER NOW!' 500 call gsvolu ( 'anl1', 'BOX ', nt_analyz, 501 x anl1_size, ndim, iv_targ ) 502 c 503 write(6,)nt_analyz,anl1_size,iv_targ 504 c 505 if ( iv_targ.le.0 ) then 506 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ 507 write ( 6,* ) ' analyzer geometry setup failed' 508 stop 509 end if 510 c 511 c 512 write(,)'analyzer 1 thickness = ',anl1_size(3)2.0 513 write(,)'nt_sci = ',nt_sci 514 write(,)'nt_ch2 = ',nt_ch2 515 write(,*)'nt_analyz = ',nt_analyz 516 c
517 jones 1.1 c
518 brash 1.3 write(6,*)'defining aire volume now' 519 call gsvolu ( 'aire', 'BOX ', nt_air, 520 x aire_size, ndim, iv_targ )
521 jones 1.1 c 522 if ( iv_targ.le.0 ) then 523 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
524 brash 1.3 write ( 6,* ) ' aire geometry setup failed'
525 jones 1.1 stop 526 end if 527 c
528 jones 1.2 c 529 write(6,)'defining fch1 volume now' 530 call gsvolu ( 'fch1', 'BOX ', nt_air, 531 x fch1_size, ndim, iv_targ ) 532 c 533 if ( iv_targ.le.0 ) then 534 write ( 6, ) ' ugeom: error, iv_targ=',iv_targ 535 write ( 6,* ) ' fch1 geometry setup failed' 536 stop 537 end if 538 c 539 c
540 brash 1.3 write(6,*)'defining airf volume now' 541 call gsvolu ( 'airf', 'BOX ', nt_air, 542 x airf_size, ndim, iv_targ )
543 jones 1.2 c 544 if ( iv_targ.le.0 ) then 545 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
546 brash 1.3 write ( 6,* ) ' airf geometry setup failed'
547 jones 1.2 stop 548 end if 549 c 550 c 551 write(6,)'defining fch2 volume now' 552 call gsvolu ( 'fch2', 'BOX ', nt_air, 553 x fch2_size, ndim, iv_targ ) 554 c 555 if ( iv_targ.le.0 ) then 556 write ( 6, ) ' ugeom: error, iv_targ=',iv_targ 557 write ( 6,* ) ' fch2 geometry setup failed' 558 stop 559 end if 560 c 561 c
562 brash 1.3 write(6,*)'defining airg volume now' 563 call gsvolu ( 'airg', 'BOX ', nt_air, 564 x airg_size, ndim, iv_targ )
565 jones 1.2 c 566 if ( iv_targ.le.0 ) then 567 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
568 brash 1.3 write ( 6,* ) ' airg geometry setup failed'
569 jones 1.2 stop 570 end if 571 c
572 jones 1.1 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 573 c
574 jones 1.2 write(6,*)'DEFINING THE SECOND ANALYZER NOW!' 575 call gsvolu ( 'anl2', 'BOX ', nt_analyz, 576 x anl2_size, ndim, iv_targ )
577 jones 1.1 c
578 jones 1.2 write(6,*)nt_analyz,anl2_size,iv_targ
579 jones 1.1 c 580 if ( iv_targ.le.0 ) then 581 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
582 jones 1.2 write ( 6,* ) ' anl2 geometry setup failed'
583 jones 1.1 stop 584 end if 585 c 586 c
587 jones 1.2 write(,)'analyzer 2 thickness = ',anl2_size(3)*2.0
588 jones 1.1 write(,)'nt_sci = ',nt_sci
589 jones 1.2 write(,)'nt_ch2 = ',nt_ch2
590 jones 1.1 write(,)'nt_analyz = ',nt_analyz 591 c 592 c
593 brash 1.3 write(6,*)'defining airh volume now' 594 call gsvolu ( 'airh', 'BOX ', nt_air, 595 x airh_size, ndim, iv_targ )
596 jones 1.2 c 597 if ( iv_targ.le.0 ) then 598 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
599 brash 1.3 write ( 6,* ) ' airh geometry setup failed'
600 jones 1.2 stop 601 end if
602 jones 1.1 c 603 c
604 jones 1.2 write(6,*)'defining fch3 volume now' 605 call gsvolu ( 'fch3', 'BOX ', nt_air, 606 x fch3_size, ndim, iv_targ )
607 jones 1.1 c 608 if ( iv_targ.le.0 ) then 609 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
610 jones 1.2 write ( 6,* ) ' fch3 geometry setup failed'
611 jones 1.1 stop 612 end if 613 c
614 jones 1.2 c
615 brash 1.3 write(6,*)'defining airi volume now' 616 call gsvolu ( 'airi', 'BOX ', nt_air, 617 x airi_size, ndim, iv_targ )
618 jones 1.1 c 619 if ( iv_targ.le.0 ) then 620 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
621 brash 1.3 write ( 6,* ) ' airi geometry setup failed'
622 jones 1.1 stop 623 end if 624 c
625 jones 1.2 c 626 write(6,*)'defining fch4 volume now' 627 call gsvolu ( 'fch4', 'BOX ', nt_air, 628 x fch4_size, ndim, iv_targ ) 629 c
630 jones 1.1 if ( iv_targ.le.0 ) then 631 write ( 6,* ) ' ugeom: error, iv_targ=',iv_targ
632 jones 1.2 write ( 6,* ) ' fch4 geometry setup failed' 633 stop
634 jones 1.1 end if
635 jones 1.2 c 636 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 637 c 638 c
639 jones 1.1 640 c 641 c make the target "SEEN" in the pictures and give it COLOr number 3 642 c (probably green) and then position it inside the mother volume 643 c 644 call gsatt ( 'aira', 'SEEN', 1 ) 645 call gsatt ( 'aira', 'COLO', 1 ) 646 call gspos ( 'aira', 1, 'HALL', 0.,0.,real(zaira),irot,'only' ) 647 call gsatt ( 'airb', 'SEEN', 1 ) 648 call gsatt ( 'airb', 'COLO', 1 ) 649 call gspos ( 'airb', 1, 'HALL', 0.,0.,real(zairb),irot,'only' ) 650 call gsatt ( 'airc', 'SEEN', 1 ) 651 call gsatt ( 'airc', 'COLO', 1 ) 652 call gspos ( 'airc', 1, 'HALL', 0.,0.,real(zairc),irot,'only' ) 653 call gsatt ( 'aird', 'SEEN', 1 ) 654 call gsatt ( 'aird', 'COLO', 1 )
655 brash 1.3 call gspos ( 'aird', 1, 'HALL', -5.08,0.,real(zaird),irot,'only' )
656 jones 1.2 call gsatt ( 'aire', 'SEEN', 1 ) 657 call gsatt ( 'aire', 'COLO', 1 )
658 brash 1.3 call gspos ( 'aire', 1, 'HALL',-5.08,0.,real(zaire),irot,'only' )
659 jones 1.2 call gsatt ( 'airf', 'SEEN', 1 ) 660 call gsatt ( 'airf', 'COLO', 1 )
661 brash 1.3 call gspos ( 'airf', 1, 'HALL',-5.08,0.,real(zairf),irot,'only' )
662 jones 1.2 call gsatt ( 'airg', 'SEEN', 1 ) 663 call gsatt ( 'airg', 'COLO', 1 )
664 brash 1.3 call gspos ( 'airg', 1, 'HALL',-5.08,0.,real(zairg),irot,'only' )
665 jones 1.2 call gsatt ( 'airh', 'SEEN', 1 ) 666 call gsatt ( 'airh', 'COLO', 1 )
667 brash 1.3 call gspos ( 'airh', 1, 'HALL',-5.08,0.,real(zairh),irot,'only' ) 668 call gsatt ( 'airi', 'SEEN', 1 ) 669 call gsatt ( 'airi', 'COLO', 1 ) 670 call gspos ( 'airi', 1, 'HALL',-5.08,0.,real(zairi),irot,'only' ) 671
672 jones 1.1 c 673 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 674 c
675 jones 1.2 call gsatt ( 'anl1', 'SEEN', 1 ) 676 call gsatt ( 'anl1', 'COLO', 4 )
677 brash 1.3 call gspos ( 'anl1', 1, 'HALL', -5.08,0.,real(zanl1),irot,'only' )
678 jones 1.2 call gsatt ( 'anl2', 'SEEN', 1 ) 679 call gsatt ( 'anl2', 'COLO', 4 )
680 brash 1.3 call gspos ( 'anl2', 1, 'HALL', -5.08,0.,real(zanl2),irot,'only' )
681 jones 1.2 c 682 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 683 c 684 call gsatt ( 'hch1', 'SEEN', 1 ) 685 call gsatt ( 'hch1', 'COLO', 2 ) 686 call gspos ( 'hch1', 1, 'HALL', 0.,0.,real(zhch1),irot,'only' ) 687 call gsatt ( 'hch2', 'SEEN', 1 ) 688 call gsatt ( 'hch2', 'COLO', 2 ) 689 call gspos ( 'hch2', 1, 'HALL', 0.,0.,real(zhch2),irot,'only' ) 690 c 691 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 692 c 693 call gsatt ( 'fch1', 'SEEN', 1 ) 694 call gsatt ( 'fch1', 'COLO', 5 )
695 brash 1.3 call gspos ( 'fch1', 1, 'HALL', -5.08,0.,real(zfch1),irot,'only' )
696 jones 1.2 call gsatt ( 'fch2', 'SEEN', 1 ) 697 call gsatt ( 'fch2', 'COLO', 5 )
698 brash 1.3 call gspos ( 'fch2', 1, 'HALL', -5.08,0.,real(zfch2),irot,'only' )
699 jones 1.2 call gsatt ( 'fch3', 'SEEN', 1 ) 700 call gsatt ( 'fch3', 'COLO', 5 )
701 brash 1.3 call gspos ( 'fch3', 1, 'HALL', -5.08,0.,real(zfch3),irot,'only' )
702 jones 1.2 call gsatt ( 'fch4', 'SEEN', 1 ) 703 call gsatt ( 'fch4', 'COLO', 5 )
704 brash 1.3 call gspos ( 'fch4', 1, 'HALL', -5.08,0.,real(zfch4),irot,'only' )
705 jones 1.1 c 706 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 707 c 708 call gsatt ( 'sci1', 'SEEN', 1 )
709 jones 1.2 call gsatt ( 'sci1', 'COLO', 3 )
710 jones 1.1 call gspos ( 'sci1', 1, 'HALL', 0.,0.,real(zsci1),irot,'only' )
711 brash 1.3 call gsatt ( 'sci2', 'SEEN', 1 ) 712 call gsatt ( 'sci2', 'COLO', 3 ) 713 call gspos ( 'sci2', 1, 'HALL', 0.,0.,real(zsci2),irot,'only' )
714 jones 1.1 c 715 c 716 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 717 write(6,*) 'everything is positioned' 718 return 719 end 720 721 722 723 724 725 726

Analyzer/Replay: Mark Jones, Documents: Stephen Wood