[807] | 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 |
---|