1 | |
---|
2 | SUBROUTINE UGEOM |
---|
3 | * |
---|
4 | #include "geomate.inc" |
---|
5 | * |
---|
6 | DIMENSION AWAT(2),ZWAT(2),WWAT(2) |
---|
7 | DIMENSION AAIR(2),ZAIR(2),WAIR(2) |
---|
8 | DIMENSION PALL(3),PVOL(3) |
---|
9 | C |
---|
10 | C COMPOUND/MIXTURE PARAMETERS |
---|
11 | C |
---|
12 | DATA AWAT/1.01,16.00/ |
---|
13 | DATA ZWAT/1.,8./ |
---|
14 | DATA WWAT/2.,1./ |
---|
15 | DATA AAIR/14.01,16.00/ |
---|
16 | DATA ZAIR/7.,8./ |
---|
17 | DATA WAIR/0.7,0.3/ |
---|
18 | C |
---|
19 | C DEFINE MATERIALS |
---|
20 | C |
---|
21 | CALL GSMATE(21,'BERYLLIUM',9.010,4.,1.848,35.30,0.,0,0) |
---|
22 | CALL GSMATE(22,'ALUMINIUM',26.98,13.,2.70,8.900,0.,0,0) |
---|
23 | CALL GSMATE(23,'SILICON',28.09,14.,2.33,9.36,45.49,0,0) |
---|
24 | CALL GSMATE(24,'LIQUID ARGON',39.95,18.,1.4,14.,83.71,0,0) |
---|
25 | CALL GSMATE(25,'IRON',55.85,26.,7.87,1.760,0.,0,0) |
---|
26 | CALL GSMATE(26,'COPPER',63.54,29.,8.96,1.430,0.,0,0) |
---|
27 | CALL GSMATE(27,'GOLD',196.967,79.,19.32,0.33,0.,0,0) |
---|
28 | CALL GSMATE(28,'LEAD',207.190,82.,11.35,0.560,0.,0,0) |
---|
29 | CALL GSMATE(31,'XenonGas',131.29,54.,5.858e-3,1447.8,0.,0,0) |
---|
30 | CALL GSMATE(32,'Tungsten',183.85,74.,19.30,0.35,0.,0,0) |
---|
31 | C |
---|
32 | CALL GSMIXT(29,'WATER',AWAT,ZWAT,1.00,-2,WWAT) |
---|
33 | CALL GSMIXT(30,'AIR',AAIR,ZAIR,1.205E-3,+2,WAIR) |
---|
34 | C |
---|
35 | C DEFINE MEDIA |
---|
36 | C |
---|
37 | IFIELD=0 |
---|
38 | if (FieldW.ne.0.) IFIELD=3 |
---|
39 | FIELDM=10*FieldW |
---|
40 | * |
---|
41 | TMAXFD=10. |
---|
42 | STEMAX=1.E+10 |
---|
43 | DEEMAX=0.20 |
---|
44 | EPSIL=0.0001 |
---|
45 | STMIN=0.0010 |
---|
46 | C |
---|
47 | CALL GSTMED(99,'WORLD',MATWLD,0,IFIELD, |
---|
48 | * FIELDM,TMAXFD,STEMAX,DEEMAX,EPSIL,STMIN,0,0) |
---|
49 | C |
---|
50 | |
---|
51 | IFIELD=0 |
---|
52 | if (FieldA.ne.0.) IFIELD=3 |
---|
53 | FIELDM=10*FieldA |
---|
54 | * |
---|
55 | DEEMAX=DEEM |
---|
56 | STMIN =STMI |
---|
57 | STEMAX=STMA |
---|
58 | CALL GSTMED(1,'ABSORBER',MATABS,0,IFIELD, |
---|
59 | * FIELDM,TMAXFD,STEMAX,DEEMAX,EPSIL,STMIN,0,0) |
---|
60 | C |
---|
61 | C |
---|
62 | C DEFINE VOLUMES (WORLD+ABSORBER) |
---|
63 | * |
---|
64 | if(XWORLD*YZWORL.le.0.) then |
---|
65 | XWORLD=1.5*XABSOR |
---|
66 | YZWORL=1.2*YZABSO |
---|
67 | endif |
---|
68 | * |
---|
69 | PALL(1)=0.5*XWORLD |
---|
70 | PALL(2)=0.5*YZWORL |
---|
71 | PALL(3)=0.5*YZWORL |
---|
72 | CALL GSVOLU('worl','BOX ',99,PALL,3,IVOL) |
---|
73 | C |
---|
74 | PVOL(1)=0.5*XABSOR |
---|
75 | PVOL(2)=0.5*YZABSO |
---|
76 | PVOL(3)=0.5*YZABSO |
---|
77 | CALL GSVOLU('abso','BOX ', 1,PVOL,3,IVOL) |
---|
78 | C |
---|
79 | C BUILD GEOMETRY |
---|
80 | C |
---|
81 | CALL GSPOS('abso',1,'worl',XPOSAB,0.,0.,0,'ONLY') |
---|
82 | * |
---|
83 | X1ABSO = XPOSAB - 0.5*XABSOR |
---|
84 | X2ABSO = XPOSAB + 0.5*XABSOR |
---|
85 | * |
---|
86 | * *** Close geometry banks. (mandatory system routine) |
---|
87 | CALL GGCLOS |
---|
88 | * |
---|
89 | * |
---|
90 | * *** dessin |
---|
91 | CALL GSATT ('*','SEEN',1) |
---|
92 | * |
---|
93 | DO IX = 1,3 |
---|
94 | CALL GDOPEN (IX) |
---|
95 | SCALE = 18./max(XWORLD,YZWORL) |
---|
96 | PAXIS = 0. |
---|
97 | SAXIS = 0.1*max(XWORLD,YZWORL) |
---|
98 | CALL GDRAWC ('worl',IX,0.,10.,9.3,SCALE,SCALE) |
---|
99 | CCC CALL GDAXIS (PAXIS,PAXIS,PAXIS,SAXIS) |
---|
100 | CALL GDSCAL (10., 0.3) |
---|
101 | CALL GDCLOS |
---|
102 | END DO |
---|
103 | * |
---|
104 | END |
---|