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.7 nanalyz = ncarbo
327 c 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
|