ugeom.F

Go to the documentation of this file.

      SUBROUTINE ugeom
*
#include "geomate.inc"
*
      dimension awat(2),zwat(2),wwat(2)
      dimension aair(2),zair(2),wair(2)
      dimension pall(3),pvol(3)
C
C     COMPOUND/MIXTURE PARAMETERS
C
      DATA awat/1.01,16.00/
      DATA zwat/1.,8./
      DATA wwat/2.,1./
      DATA aair/14.01,16.00/
      DATA zair/7.,8./
      DATA wair/0.7,0.3/
C
C     DEFINE  MATERIALS
C
      CALL gsmate(21,'BERYLLIUM',9.010,4.,1.848,35.30,0.,0,0)
      CALL gsmate(22,'ALUMINIUM',26.98,13.,2.70,8.900,0.,0,0)
      CALL gsmate(23,'SILICON',28.09,14.,2.33,9.36,45.49,0,0)
      CALL gsmate(24,'LIQUID ARGON',39.95,18.,1.4,14.,83.71,0,0)
      CALL gsmate(25,'IRON',55.85,26.,7.87,1.760,0.,0,0)
      CALL gsmate(26,'COPPER',63.54,29.,8.96,1.430,0.,0,0)
      CALL gsmate(27,'GOLD',196.967,79.,19.32,0.33,0.,0,0)
      CALL gsmate(28,'LEAD',207.190,82.,11.35,0.560,0.,0,0)
      CALL gsmate(31,'XenonGas',131.29,54.,5.858e-3,1447.8,0.,0,0)
      CALL gsmate(32,'Tungsten',183.85,74.,19.30,0.35,0.,0,0)            
C
      CALL gsmixt(29,'WATER',awat,zwat,1.00,-2,wwat)
      CALL gsmixt(30,'AIR',aair,zair,1.205e-3,+2,wair)
C
C     DEFINE MEDIA
C
      ifield=0
      if (fieldw.ne.0.) ifield=3
      fieldm=10*fieldw
*      
      tmaxfd=10.
      stemax=1.e+10
      deemax=0.20
      epsil=0.0001
      stmin=0.0010
C
      CALL gstmed(99,'WORLD',matwld,0,ifield,
     *            fieldm,tmaxfd,stemax,deemax,epsil,stmin,0,0)
C

      ifield=0
      if (fielda.ne.0.) ifield=3
      fieldm=10*fielda
*      
      deemax=deem
      stmin =stmi
      stemax=stma
      CALL gstmed(1,'ABSORBER',matabs,0,ifield,
     *            fieldm,tmaxfd,stemax,deemax,epsil,stmin,0,0)
C
C
C     DEFINE VOLUMES (WORLD+ABSORBER)
*
      if(xworld*yzworl.le.0.) then
        xworld=1.5*xabsor 
        yzworl=1.2*yzabso
      endif
*              
      pall(1)=0.5*xworld   
      pall(2)=0.5*yzworl     
      pall(3)=0.5*yzworl
      CALL gsvolu('worl','BOX ',99,pall,3,ivol)
C
      pvol(1)=0.5*xabsor
      pvol(2)=0.5*yzabso
      pvol(3)=0.5*yzabso 
      CALL gsvolu('abso','BOX ', 1,pvol,3,ivol)
C
C     BUILD  GEOMETRY
C
      CALL gspos('abso',1,'worl',xposab,0.,0.,0,'ONLY')
*      
      x1abso = xposab - 0.5*xabsor
      x2abso = xposab + 0.5*xabsor
*                                                                               
* *** Close geometry banks. (mandatory system routine)                         
      CALL ggclos
*
*
* *** dessin
      CALL gsatt('*','SEEN',1)
*                                                                     
      DO ix = 1,3
        CALL gdopen(ix)
        scale =   18./max(xworld,yzworl)
        paxis =   0.
        saxis =   0.1*max(xworld,yzworl)
        CALL gdrawc('worl',ix,0.,10.,9.3,scale,scale)
CCC        CALL GDAXIS (PAXIS,PAXIS,PAXIS,SAXIS)
        CALL gdscal(10., 0.3)
        CALL gdclos
      END DO
*      
      END