TestEm3/geant3/src/uginit.F

Go to the documentation of this file.

      SUBROUTINE uginit
*
*     To initialise GEANT/USER  program and read data cards
*
#include "calor.inc"
#include "celoss.inc"
#include "histo.inc"
#include "geant321/gckine.inc"
#include "geant321/gcbank.inc"
*
      CHARACTER*20 filnam
*
* *** Define the GEANT parameters
      CALL ginit
*
* *** default values for histo
      do ih = 1,maxhist
        histo(ih) = .false.
      enddo                                                        
*
* *** Calor definition
      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,5,'MIXED')
* *** max allowed step size       
      CALL ffkey('STEPMX',stepmax,1,'REAL')
*                                                                          
* *** read data cards
      print *, 'G3 > gives the filename of the data cards to be read:'
      READ (*,'(A)') filnam
      IF (filnam.EQ.' ') filnam = 'run01.dat'
      OPEN (unit=5,file=filnam,status='unknown',form='formatted')
*
*     fileName for histograms, must be 1st data card !
      filename = 'testem3.paw'
      READ(5,98)key,spaces,filename
98    FORMAT(a4,a2,a25)

      CALL gffgo
*
* *** check size of arrays
      if (nbabsor.gt.maxabs) then
        write (6,51) nbabsor, maxabs
    nbabsor = maxabs
      endif
      if (nblayer.gt.maxlay) then
        write (6,52) nblayer, maxlay
    nblayer = maxlay
      endif         
51    FORMAT (/,5x,'warning (uginit): NbAbsor= ',i2,' truncated to ',i2)
52    FORMAT (/,5x,'warning (uginit): NbLayer= ',i3,' truncated to ',i3)

      write(6,99) filename
99    FORMAT(/,15x,'histogram file --> Name: ',a25)

      CALL gzinit
      CALL gpart
      CALL gpions
*
* *** overwrite ITRTYP for ion C12
      jpa = lq(jpart-67)
      q(jpa+6) = 8.0       
*
      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)                                                     
*
* *** some initialisation
      do k=1,maxabs
        sumedep(k) = 0.
        sumtrck(k) = 0.
        su2edep(k) = 0.
        su2trck(k) = 0.
      enddo                                                         
*
      do k=1,maxplanes
        enerflow(k) = 0.
        eleaklat(k) = 0.
      enddo                                                         
*                                                                               
      END