geant3/src/ugeom.F

0001
0002       SUBROUTINE UGEOM
0003 *
0004 * *** Define user geometry set up
0005 *
0006 #include "calor.inc"
0007 #include "geant321/gcbank.inc"
0008 *
0009       DIMENSION PAR(3)
0010
0011       DIMENSION Aair(2),Zair(2),Wair(2)
0012       DIMENSION ACO2(2),ZCO2(2),WCO2(2)
0013       DIMENSION AH2O(2),ZH2O(2),WH2O(2)
0014       DIMENSION AG10(4),ZG10(4),WG10(4)
0015       DIMENSION Asci(2),Zsci(2),Wsci(2)
0016       DIMENSION ACsI(2),ZCsI(2),WCsI(2)
0017 *
0018       CHARACTER*4  volnam
0019       CHARACTER*20 matnam
0020 *
0021 * *** Air compound parameters
0022       DATA Aair/14.01, 16.00/
0023       DATA Zair/ 7.  ,  8.  /
0024       DATA Wair/ 0.7 ,  0.3 /
0025 *
0026 * *** CO2 compound parameters
0027       DATA ACO2/12.01, 16.00/
0028       DATA ZCO2/ 6.  ,  8.  /
0029       DATA WCO2/ 1.  ,  2.  /
0030 *
0031 * *** Water compound parameters
0032       DATA AH2O/ 1.01, 16.00/
0033       DATA ZH2O/ 1.  ,  8.  /
0034       DATA WH2O/ 2.  ,  1.  /
0035 *
0036 * *** G10 compound parameters
0037       DATA AG10/ 1.01, 12.00, 16.00, 28.00/
0038       DATA ZG10/ 1.  ,  6.  ,  8.  , 14.  /
0039       DATA WG10/ 3.  ,  3.  ,  2.  ,  1.  /
0040 *
0041 * *** Scintillator compound parameters
0042       DATA Asci/12.01,  1.01/
0043       DATA Zsci/ 6.  ,  1.  /
0044       DATA Wsci/ 9.  , 10.  /
0045 *
0046 * *** CsI compound parameters
0047       DATA ACsI/ 126.90, 132.90/
0048       DATA ZCsI/ 53.   , 55.   /
0049       DATA WCsI/ 1.    , 1.    /
0050 *
0051 * *** Defines USER perticular materials
0052       CALL GSMIXT( 1,'Air'      , Aair ,Zair, 1.29E-3, 2   , Wair)
0053       CALL GSMIXT( 2,'CO2 gas'  , ACO2 ,ZCO2, 27.0E-3,-2   , WCO2)
0054       CALL GSMATE( 3,'H2 Liquid',  1.008,  1., 0.0708 , 865., 790., 0,0)
0055       CALL GSMIXT( 4,'Water'    , AH2O ,ZH2O, 1.0    ,-2   , WH2O)
0056       CALL GSMATE( 5,'Liquid Ar', 39.95, 18., 1.39   , 14.0, 84.0, 0,0)
0057       CALL GSMATE( 6,'Aluminium', 26.98, 13., 2.7    ,  8.9, 37.2, 0,0)
0058       CALL GSMATE( 7,'Iron     ', 55.85, 26., 7.87   , 1.76, 17.1, 0,0)
0059       CALL GSMATE( 8,'Lead     ',207.19, 82., 11.35  , 0.56, 18.5, 0,0)
0060       CALL GSMATE( 9,'Uranium  ',238.03, 92., 18.95  , 0.32, 12. , 0,0)
0061       CALL GSMATE(10,'Silicon  ', 28.09, 14.,  2.33  , 9.36, 45.5, 0,0)
0062       CALL GSMATE(11,'Tungsten ',183.85, 74., 19.30  , 0.35,  9.6, 0,0)
0063       CALL GSMIXT(12,'NemaG10'  , AG10 ,ZG10, 1.7    ,-4   , WG10)
0064       CALL GSMATE(13,'Copper   ', 63.55, 29., 8.96   , 1.43, 15.0, 0,0)
0065       CALL GSMIXT(14,'Scintilla', Asci ,Zsci, 1.032  ,-2   , Wsci)
0066       CALL GSMATE(15,'Gold     ',196.97, 79., 19.32  , 0.33,  9.6, 0,0)
0067       CALL GSMIXT(16,'CsI      ', ACsI ,ZCsI, 4.534  ,-2   , WCsI)
0068 *
0069 * *** overwrite the computed radlength of some mixture
0070       JMA = LQ(JMATE-14)
0071       Q(JMA+9) = 42.549
0072 *
0073 *
0074 * *** Defines USER tracking media parameters
0075       IFIELD = 0
0076       IF (Field.GT.0.) IFIELD = 3
0077       FIELDM = 10*Field
0078       TMAXFD = 10.0
0079       STEMAX = 1000.
0080       IF (stepmax.gt.0.) STEMAX = stepmax
0081       DEEMAX = 0.20
0082       EPSIL  = 0.001
0083       STMIN  = 0.010
0084 *
0085       do k=1,NbAbsor
0086         CALL GSTMED( k,'absorber',materAbs(k), 0 ,IFIELD,FIELDM,TMAXFD,
0087      *                 STEMAX,DEEMAX,EPSIL,STMIN, 0 , 0 )
0088       enddo
0089 *
0090 * *** set specific bcute/dcute (if any)
0091       do k=1,4*NbAbsor,4
0092          itm = prodcut(k) + 0.01
0093         if(itm.ge.1) then
0094            call GSTPAR(itm,'BCUTE' ,prodcut(k+1))
0095            call GSTPAR(itm,'BCUTM' ,prodcut(k+1))
0096            call GSTPAR(itm,'DCUTE' ,prodcut(k+2))
0097            call GSTPAR(itm,'DCUTM' ,prodcut(k+2))
0098            call GSTPAR(itm,'PPCUTM',prodcut(k+3))
0099         endif
0100       enddo
0101 *
0102       nudef = NbAbsor+1
0103       CALL GSTMED( nudef,'default' , 1    , 0 ,IFIELD,FIELDM,TMAXFD,
0104      *                 STEMAX,DEEMAX,EPSIL,STMIN, 0 , 0 )
0105 *
0106 *
0107 * *** calor dimensions
0108       thLayer = 0.
0109       do k=1,NbAbsor
0110         thLayer = thLayer + thickAbs(k)
0111       enddo
0112       calorX  = NbLayer*thLayer
0113       worldX  = 1.2*calorX
0114       worldYZ = 1.2*calorYZ
0115 *
0116 * *** world
0117       PAR(1) = worldX /2.
0118       PAR(2) = worldYZ/2.
0119       PAR(3) = worldYZ/2.
0120       CALL GSVOLU('worl','BOX ',nudef,PAR,3,IVOL)
0121 *
0122 * *** calorimeter
0123       PAR(1) = calorX /2.
0124       PAR(2) = calorYZ/2.
0125       PAR(3) = calorYZ/2.
0126       CALL GSVOLU('calo','BOX ',nudef,PAR,3,IVOL)
0127       CALL GSPOS ('calo',1,'worl',0.,0.,0.,0,'ONLY')
0128 *
0129 * *** layers
0130       CALL GSDVN ('layr','calo',NbLayer,1)
0131 *
0132 * *** absorbers
0133       volnam = 'abs'
0134       xfront = -0.5*thLayer
0135       do k=1,NbAbsor
0136         PAR(1) = thickAbs(k)/2.
0137         PAR(2) = calorYZ/2.
0138         PAR(3) = calorYZ/2.
0139         volnam(4:4) = char(ichar('0')+k)
0140         CALL GSVOLU(volnam,'BOX ',k,PAR,3,IVOL)
0141         xcenter = xfront + 0.5*thickAbs(k)
0142         CALL GSPOS (volnam,1,'layr',xcenter,0.,0.,0,'ONLY')
0143         xfront = xfront + thickAbs(k)
0144       enddo
0145 *
0146 * *** Close geometry banks. (mandatory system routine)
0147       CALL GGCLOS
0148 *
0149 * *** print geometry
0150       PRINT 749
0151       PRINT 751,NbLayer
0152       do k=1,NbAbsor
0153         call GFMATE (materAbs(k),matnam,dua,duz,dud,dur,dui,udu,idu)
0154         PRINT 752,matnam,thickAbs(k)
0155       enddo
0156       PRINT 749
0157 *
0158   749 FORMAT(/ ,60(1H-),/)
0159   751 FORMAT(1X,'The calorimeter is ',I2,' layers of:')
0160   752 FORMAT(5X,A10,': ',F8.4,' cm')
0161 *
0162 * *** dessin
0163       CALL GSATT ('*'   ,'SEEN',1)
0164       CALL GSATT ('layr','SEEN',0)
0165 *
0166       DO IX = 1,3
0167         CALL GDOPEN (IX)
0168         SCALE =   18./max(worldX,worldYZ)
0169         PAXIS =   0.
0170         SAXIS =   1.
0171         CALL GDRAWC ('worl',IX,0.,10.,9.3,SCALE,SCALE)
0172 CCC        CALL GDAXIS (PAXIS,PAXIS,PAXIS,SAXIS)
0173         CALL GDSCAL (10. , 0.3)
0174         CALL GDCLOS
0175       END DO
0176 *
0177       END