Import Geant4 3.1.0 source tree

examples/extended/electromagnetic/TestEm3/geant3/src/ffuser.F

@@ -0,0 +1,20 @@
+
+      SUBROUTINE FFUSER(ikey)
+*
+*     The routine is called when a *key card is read
+*
+#include "calor.inc"
+#include "histo.inc"
+*
+      CHARACTER*4  keyw
+      CHARACTER*25 title      
+*
+      call UHTOC(ikey,4,keyw,4)
+      if (keyw.eq.'HIST') then
+        if (iexist(idhist).eq.1) call hdelet(idhist)
+	title = 'Edep/Ebeam in absorber '//char(ichar('0')+(idhist-1))	
+	call hbook1(idhist,title,nbinE,Emin,Emax,0.)
+	iexist(idhist) = 1
+      endif			   
+*                                                                               
+      END                                                                       

examples/extended/electromagnetic/TestEm3/geant3/src/guout.F

@@ -4,10 +4,10 @@
 *     User routine called at the end of each event
 *     
 #include "geant321/gcflag.inc"
+#include "geant321/gckine.inc"
 #include "calor.inc"
 #include "celoss.inc"
 *
-      DIMENSION sumevent(2*MaxAbS)
       CHARACTER*4 unit
 *                                                                               
 * *** drawing
@@ -20,12 +20,11 @@
       END IF
 #endif      
 *
-*     ntuple: energies and track length per event
+*     histo: energy deposit per tracking medium
       do k=1,NbAbsor
-        sumevent(2*k-1) = EdepAbs(k)
-        sumevent(2*k  ) = TrckAbs(k)
+        ratio = EdepAbs(k)/pkine(1)
+	call hfill (k,ratio,0.,1.)
       enddo
-      CALL HFN(1,sumevent)     
 *
 *     cumul energy deposited and charged track length
       do k=1,NbAbsor

examples/extended/electromagnetic/TestEm3/geant3/src/main.F

@@ -4,7 +4,7 @@
       PROGRAM main
 *
 *
-      PARAMETER (NGBANK=100000, NHBOOK=40000)
+      PARAMETER (NGBANK=100000, NHBOOK=100000)
       COMMON/GCBANK/Q(NGBANK)
       COMMON/PAWC  /H(NHBOOK)
 *

examples/extended/electromagnetic/TestEm3/geant3/src/ugeom.F

@@ -10,7 +10,8 @@
       DIMENSION Aair(2),Zair(2),Wair(2)
       DIMENSION ACO2(2),ZCO2(2),WCO2(2)
       DIMENSION AH2O(2),ZH2O(2),WH2O(2)
-      DIMENSION AG10(4),ZG10(4),WG10(4)                                        
+      DIMENSION AG10(4),ZG10(4),WG10(4)
+      DIMENSION Asci(2),Zsci(2),Wsci(2)                                              
 *
       CHARACTER*4  volnam
       CHARACTER*20 matnam
@@ -34,7 +35,12 @@
       DATA AG10/ 1.01, 12.00, 16.00, 28.00/
       DATA ZG10/ 1.  ,  6.  ,  8.  , 14.  /
       DATA WG10/ 3.  ,  3.  ,  2.  ,  1.  /      
-      
+*                                                                               
+* *** Scintillator compound parameters
+      DATA Asci/12.01,  1.01/
+      DATA Zsci/ 6.  ,  1.  /
+      DATA Wsci/ 9.  , 10.  /                                                                               
+
 *
 * *** Defines USER perticular materials
       CALL GSMIXT( 1,'Air'      , Aair ,Zair, 1.29E-3, 2   , Wair)
@@ -46,10 +52,11 @@
       CALL GSMATE( 7,'Iron     ', 55.85, 26., 7.87   , 1.76, 17.1, 0,0)
       CALL GSMATE( 8,'Lead     ',207.19, 82., 11.35  , 0.56, 18.5, 0,0)
       CALL GSMATE( 9,'Uranium  ',238.03, 92., 18.95  , 0.32, 12. , 0,0)
-      CALL GSMATE(10,'Silicium ', 28.09, 14.,  2.33  , 9.36, 45.5, 0,0)
+      CALL GSMATE(10,'Silicon  ', 28.09, 14.,  2.33  , 9.36, 45.5, 0,0)
       CALL GSMATE(11,'Tungsten ',183.85, 74., 19.30  , 0.35,  9.6, 0,0)
       CALL GSMIXT(12,'NemaG10'  , AG10 ,ZG10, 1.7    ,-4   , WG10)
-      CALL GSMATE(13,'Copper   ', 63.55, 29., 8.96   , 1.43, 15.0, 0,0)      
+      CALL GSMATE(13,'Copper   ', 63.55, 29., 8.96   , 1.43, 15.0, 0,0)
+      CALL GSMIXT(14,'Scintilla', Asci ,Zsci, 1.032  ,-2   , Wsci)      
 *                                               
 *                                                                               
 * *** Defines USER tracking media parameters
@@ -66,6 +73,18 @@
         CALL GSTMED( k,'absorber',materAbs(k), 0 ,IFIELD,FIELDM,TMAXFD,
      *                 STEMAX,DEEMAX,EPSIL,STMIN, 0 , 0 )
       enddo
+* 
+* *** set specific bcute/dcute (if any)     
+      do k=1,4*NbAbsor,4
+         itm = prodcut(k) + 0.01
+	if(itm.ge.1) then
+	   call GSTPAR(itm,'BCUTE' ,prodcut(k+1))
+           call GSTPAR(itm,'BCUTM' ,prodcut(k+1))	   
+	   call GSTPAR(itm,'DCUTE' ,prodcut(k+2))
+           call GSTPAR(itm,'DCUTM' ,prodcut(k+2))
+	   call GSTPAR(itm,'PPCUTM',prodcut(k+3))
+	endif   
+      enddo
 *
       nudef = NbAbsor+1
       CALL GSTMED( nudef,'default' , 1    , 0 ,IFIELD,FIELDM,TMAXFD,

examples/extended/electromagnetic/TestEm3/geant3/src/uginit.F

@@ -5,6 +5,7 @@
 *
 #include "calor.inc"
 #include "celoss.inc"
+#include "histo.inc"
 #include "geant321/gckine.inc"
 *
       CHARACTER*20 filnam
@@ -23,6 +24,10 @@
       CALL FFKEY('CALOR',NbAbsor,4,'MIXED')
       CALL FFKEY('MATE' ,materAbs(1),MaxAbs,'INTEGER')
       CALL FFKEY('THICK',thickAbs(1),MaxAbs,'REAL')
+* *** production cuts (bcute, dcute and ppcutm) for each absorber       
+      CALL FFKEY('CUTPR',prodcut(1) ,4*MaxAbs,'REAL')
+* *** histograms
+      CALL FFKEY('HISTO',idhist,4,'MIXED')            
 *
 * *** read data cards
       CALL GFFGO 

examples/extended/electromagnetic/TestEm3/geant3/src/uhinit.F

@@ -4,14 +4,17 @@
 *     To book the user's histograms
 *
 #include "calor.inc"
+#include "histo.inc"
 *
-      CHARACTER*5 chtags(20)
+      character*25 title
 *
-      DATA chtags /'EAbs0','LAbs0','EAbs1','LAbs1','EAbs2','LAbs2',
-     +             'EAbs3','LAbs3','EAbs4','LAbs4','EAbs5','LAbs5',
-     +             'EAbs6','LAbs6','EAbs7','LAbs7','EAbs8','LAbs8',
-     +	           'EAbs9','LAbs9'/		   
-*      
-      CALL HBOOKN(1,'sum per event',2*NbAbsor,' ',4000,chtags)
+* *** complete the booking of histograms
+      do k=1,NbAbsor
+        if (iexist(k).eq.0) then
+	   title = 'Edep/Ebeam in absorber '//char(ichar('0')+(k-1))
+	   call hbook1(k,title,100, 0.,1.,0.)
+	   iexist(k) = 1
+	endif
+      enddo	   	   
 *                                                                               
       END