| 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 |
|---|
