+OPTION,MAPASM.
+ASM,23.
+USE,GCDES,TestEm4,T=EXE.
*
+EXE,CRA*.
*
+PAM,11,T=CARD,T=ATTACH.     /cern/pro/src/car/geant321.car
+PATCH,TestEm4.        
+DECK,BLANKDEK.
* 
* C6F6   1.00 /01  871204 18.00 GEANT EXAMPLES
* 
*             TEST PROGRAM FOR GEANT TEST
*                                                                               
*             Author    R.Brun  *********
*                                   
*     
* History                  
* -------                                            
*
*  05-08-98 : adapted to Geant3.21, M.Maire
*                                      
                                                                               
+KEEP,CELOSS.                                                                                                                      
      COMMON/CELOSS/ ETOT                                                       

+DECK,main,if=batch.
      PROGRAM main
*
*
      PARAMETER (NGBANK=100000, NHBOOK=10000)
      COMMON/GCBANK/Q(NGBANK)
      COMMON/PAWC  /H(NHBOOK)
*
      CALL GZEBRA( NGBANK)
      CALL HLIMIT(-NHBOOK)
*
* *** initialize HIGZ
      CALL HPLINT(0)
*
* *** GEANT initialisation
      CALL UGINIT
*
* *** Start events processing
      CALL GRUN
*
* *** End of RUN
      CALL UGLAST
*
      STOP
      END
+DECK,main,IF=-batch.
      PROGRAM main
*
*     GEANT main program. To link with the MOTIF user interface
*     the routine GPAWPP(NWGEAN,NWPAW) should be called, whereas
*     the routine GPAW(NWGEAN,NWPAW) gives access to the basic
*     graphics version.
*
      PARAMETER (NWGEAN=3000000, NWPAW=1000000)
      COMMON/GCBANK/GEANT(NWGEAN)
      COMMON/PAWC  /PAW  (NWPAW)
*
*
      CALL GPAW (NWGEAN,NWPAW)
*
      END
*
      SUBROUTINE qnext
      END
*
      SUBROUTINE czopen
      END
*
      SUBROUTINE cztcp
      END
*
      SUBROUTINE czclos
      END
*
      SUBROUTINE czputa
      END
+DECK,UGINIT                                                                    
      SUBROUTINE UGINIT                                                         
*                                                                               
*     To initialise GEANT/USER  program and read data cards                     
*
      CHARACTER*20 filnam                                                                                                                                                                                                                             
*                                                                               
* *** Define the GEANT parameters                                                          
      CALL GINIT 
      
* *** read data cards
      PRINT *, 'G3 > gives the filename of the data cards to be read:'
      READ (*,'(A)') filnam
      IF (filnam.EQ.' ') filnam = 'testem4.dat'
      OPEN (unit=5,file=filnam,status='unknown',form='formatted')                                                                          

* *** read data cards                                                           
      CALL GFFGO                                                                      
*                                                                               
      CALL GZINIT                                                               
      CALL GPART 
*
      CALL GDINIT                                                                     
*                                                                               
* *** Geometry and materials description                                        
      CALL UGEOM                                                                
*                                                                               
* *** Energy loss and cross-sections initialisations                            
      CALL GPHYSI                                                               
*                                                                               
      CALL GPRINT('MATE',0)                                                     
      CALL GPRINT('TMED',0)                                                     
      CALL GPRINT('VOLU',0)                                                     
*                                                                                                                                                              
* *** Define user histograms                                                    
      CALL UHINIT                                                               
*                                                                               
      END                                                                       
+DECK,UGEOM.                                                                    
      SUBROUTINE UGEOM                                                          
*                                                                               
* *** Define user geometry set up                                               
*                                                                                                                                                                                                                       
*                                                                               
      DIMENSION PAR(3)                                                         
      DIMENSION AC6F6(2),ZC6F6(2),WC6F6(2)
*                                                                               
* *** C6F6 compound parameters                                                   
      DATA AC6F6/12.02, 19.01/                                            
      DATA ZC6F6/ 6.  ,  9.  /                                                     
      DATA WC6F6/ 6.  ,  6.  /                                                                                                                
*                    
      CALL GSMIXT(1,'C6F6',AC6F6,ZC6F6,1.61,-2,WC6F6)
*                                               
*                                                                               
* *** Defines USER tracking media parameters
      IMAT   = 1                                    
      FIELDM = 0.0                                                             
      IFIELD = 0                                                               
      TMAXFD = 10.0                                                             
      STEMAX = 1000.                                                            
      DEEMAX = 0.20                                                            
      EPSIL  = 0.001                                                           
      STMIN  = 0.010                                                           
*                                                                               
      CALL GSTMED( 1,'C6F6',IMAT, 0 ,IFIELD,FIELDM,TMAXFD,                
     *               STEMAX,DEEMAX,EPSIL,STMIN, 0 , 0 )        
*
*
* *** Geometry                                                                               
      PAR(1) = 0.                                                               
      PAR(2) = 5.                                                               
      PAR(3) = 5.                                                               
      CALL GSVOLU('C6F6','TUBE',1,PAR,3,IVOL)                     
*                                                                               
* *** Close geometry banks. (obligatory system routine)                         
      CALL GGCLOS                                                               
*
*
* *** dessin
      CALL GSATT ('*','SEEN',1)
*
      DO IX = 1,3
        CALL GDOPEN (IX)
        SCALE =   1.75
        PAXIS =   0.
        SAXIS =   1.
        CALL GDRAWC ('C6F6',IX,0.,10.,9.5,SCALE,SCALE)
        CALL GDAXIS (PAXIS,PAXIS,PAXIS,SAXIS)
        CALL GDSCAL (10. , 0.3)
        CALL GDCLOS
      END DO
*
                                                                               
      END                                                                       
+DECK,UHINIT.                                                                   
      SUBROUTINE UHINIT                                                         
*                                                                               
*     To book the user's histograms                                             
*                                                                                                                                                              
      CALL HBOOK1(1,'total energy deposit in C6F6 (MeV)'             
     *,100, 0., 10., 0.)                                                     

      CALL HIDOPT(0,'STAT')                               
*                                                                               
      END                                                                       
+DECK,GUKINE                                                                    
      SUBROUTINE GUKINE                                                         
*                                                                               
*    Generates Kinematics for primary track
*
*    Data card Kine : Itype  Ekine                                       
*                                                                               
+SEQ,GCONST,GCFLAG,GCKINE.                                                                                                                           
*                                                                               
      DIMENSION VERTEX(3),PLAB(3)
      DIMENSION RNDM(2)
*                                                     
      DATA VERTEX/3*0./                                                                                                                  
*
*                                                                  
      CALL GSVERT(VERTEX,0,0,0,0,NVERT)
*
      CALL GRNDM(RNDM,2)
      THETA = PI*RNDM(1)
      PHI   = TWOPI*RNDM(2)                                
*                                                         
      PLAB(1)  = PKINE(1)*SIN(THETA)*COS(PHI)
      PLAB(2)  = PKINE(1)*SIN(THETA)*SIN(PHI)
      PLAB(3)  = PKINE(1)*COS(THETA)                                       
*                                                          
      CALL GSKINE(PLAB,IKINE,NVERT,0,0,NT)                           
*                                                                   
* *** Kinematics debug                     
      IF (IEVENT.EQ.1.OR.IDEBUG.NE.0) CALL GPRINT('KINE',0)                                                                     
*                                                                               
      END                                                                       
+DECK,GUTREV                                                          
      SUBROUTINE GUTREV                                                         
*                                                                               
*     User routine to control tracking of one event                 
*     Called by GRUN                                                            
*                                                                     
+SEQ,CELOSS                                                                     
*                                                                          
      ETOT = 0.                                                               
*                                                                               
      CALL GTREVE                                                               
*                                                                               
      END                                                                       
+DECK,GUSTEP                                                                    
      SUBROUTINE GUSTEP                                                         
*                                                                               
*     User routine called at the end of each tracking step           
*                                                               
+SEQ,GCFLAG.
+SEQ,GCKINE,GCKING,GCTRAK.                                 
+SEQ,CELOSS.                                                             
*                                                                               
*                                                                               
* *** Debug event and store tracks for drawing
      IF (IDEBUG.NE.0)   CALL GPCXYZ      
      IF ((ISWIT(1).EQ.1).AND.(CHARGE.NE.0.)) CALL GSXYZ
      IF  (ISWIT(1).EQ.2)                     CALL GSXYZ                        
*                                                                               
* *** Something generated ?                                                     
      IF(NGKINE.GT.0) CALL GSKING(0)                                            
*                                                                               
* *** Energy deposited                                                          
      IF(DESTEP.GT.0.) ETOT = ETOT + DESTEP                                                     
*
      END                                                                       
+DECK,GUOUT                                                                     
      SUBROUTINE GUOUT                                                          
*                                                                               
*     User routine called at the end of each event                              
*                                                                               
+SEQ,GCFLAG.                                                              
+SEQ,CELOSS.                                                              
*                                                                               
* *** drawing
*
+self,if=-batch.                                                          
        IF (ISWIT(1).NE.0) THEN
         CALL GDHEAD (110110,'TestEm4',0.)
         CALL GDSHOW (3)
         CALL GDXYZ  (0)
      END IF
+self.      
*
*     energy deposited
*                                                                                
      EMEV = 1000.*ETOT                                                 
      CALL HFILL(1,EMEV,0.,1.)
      IF (ISWIT(1).NE.0) PRINT 750,EMEV
*      
  750 FORMAT(1X,'Energy deposit: ',F6.3,' MeV')    
*                                                                                
      END                                                                       
+DECK,UGLAST                                                                    
      SUBROUTINE UGLAST                                                         
*                                                                               
*     Termination routine to print histograms and statistics                    
*                                                                               
+SEQ,GCFLAG.                                                      
*                                                                                                                        
*                                                                                
      CALL GLAST
*
* *** print  selected histo                                                                               
*
* *** close HIGZ
      CALL HPLEND
*                                                                               
* *** Save selected histograms                                                  
      IF (ISWIT(2).EQ.1) THEN                                                   
         CALL HRPUT(0,'testem4.histo','N')                                                                        
      ENDIF                                                                     
*
      END
+DECK,ffread,T=data.      
LIST
TRIG  10000
KINE  1 (Itype)    0.009(Ekine)
DEBUG 1  5 1000
SWIT  0 (draw) 1 (save)
CUTS    10.e-6 (cutgam)     10.e-6 (cutele) 3*10.e-3 (cutneu/had/muo)
      2*10.e-6 (bcute/m) 2*428.e-6 (dcute/m)
LOSS  1      
ABAN  0
TIME  2= 1.
+QUIT.
