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