#include "geant321/pilot.h"
c-----------------------------------------------
c       ~/mc/geant/src/lemsr/geant_lemsr_main.F
c-----------------------------------------------
c
        program geant_lemsr
c
c       Program very much "grown", so many things could be programmed in
c       a better way...
c
c       program to simulate the response of the low energy muon muSR
c       detector setup at PSI. Some parts are taken from Nai_simul.for.
c       It is intended to steer the simulation by format free inputs
c       (routine gffgo); this can be done interactively or data sets
c       can be read from file.
c
c       Uses Run11 setup geometry.
c
c       For precession: at the moment use the total TOF for the calculation
c       of the precession angle. When the muon is started as particle code=500
c       and upstream of the target, the precession is calculated as if the
c       muon is flying all the time through the B-field.
c
c       TP      18-Jan-1999  PSI
c
c       TP, 4-Feb-1999: CW Ntuples
c       TP, 9-Feb-1999: store energy loss per detector in NTuple
c       TP,16-Feb-1999: time in NTUPLE as REAL*4 instead of INTEGER
c       TP,26-Feb-1999: If particles start upstream gaussian divergence of
c                       beam now possible.
c
c*****************************************************************************
c
c     TP, 11-May-2000         PSI
c                             Windows NT 4.0 version; uses include files which 
c                             I created manually from the VMS GEANT321.TLB text library.
c
c     TP, 15-Sep-2000         PSI
c     Unix version            Used fsplit to separate program into
c                             subroutines and functions.
c
c
c     TP, 05-Apr-2001         PSI     
c                             Unix, NT, and Linux (to be checked)
c                             version; use the Compaq Fortran fpp 
c                             precompiler on NT
c
c     17-Dec-2002 TP          extend bfield array to account for different
c                             polarization in sample (=bfield(5))
c                             gaussian muon momentum distribution possible
c                             via sets(8) and sets(9): 
c                             sigma_p = p0 * (sets(8)/100.+sets(9)/1000.)
c
c------------------------------------------------------------------
c
      implicit none
c
c     include some files from $CERN_ROOT/include/
c
c       to avoid explicitly including the gt***.inc file
c       define CERNLIB_TYPE; the gt***.inc files are then
c       automatically included in the gc***.inc files.
c
#define CERNLIB_TYPE
#include "geant321/gclist.inc"       
#include "geant321/gcflag.inc"       
#include "geant321/gcphys.inc"       
#include "geant321/gccuts.inc"      
#include "geant321/gckine.inc"       
c
#include "cwn.inc"      
#include "common.inc"
c
c
c       the particle definition (variable IPART): see GEANT manual CONS300-1
c
c       particle        IPART
c
c       gamma           1
c       positron        2
c       electron        3
c       neutrino        4
c       muon+           5
c       muon-           6
c       pion0           7
c       pion+           8
c       pion-           9
c       ...
c
      integer*4    NG, NH	
      parameter    (NG = 2000000)
      parameter    (NH = 1000000)
      integer*4    ipawc,q
      integer*4    iwktyp
      integer*4    iquest(100)
c
      common /quest/iquest         !needed to get enough space for NTUPLE
      common /pawc/ipawc(NH)
      common /gcbank/q(NG)
c
c     parameter for drawing (used in GEANT routine GDRAW)
c
      real*4       gdtheta,gdphi,gdpsi
      real*4       gdx0,gdy0,gdsx,gdsy
c
      real*4       xn,yn,scal,r(2)
      integer*4    i
c
c     for opening NTUPLE file and NTUPLE
c
      integer*4    istat
      character*72 ntfile
c
c       the run number copied from GEAN variable IDRUN
c     
      character*4  runno     
c
c     for graphic output to PostScript file
c
      character*72 psfile     
c    
      integer*4      lunin       /4/
      integer*4      ipres
      real*4         ub(1)
c
c-----------------------------------------------------------------
c
c       flags for NTUPLE variable definitions
c
c       'init'  write initial parameter to NT
c       'code'  initial particle ID to NT
c       'endp'  end position and energy of e+
c       'time'  t-mcp and t-sci
c       'scip'  position when particle hits inner Sc.
c       'scie'  energy loss of particles in inner sc.
c       'scop'  position when particle hits outer Sc.
c       'scoe'  energy loss of particles in outer sc.
c       'flag'  Vol. numbers and particle codes; needed to get the single
c               decay spectra
c       'nhit'  Number of Hits in detectors MCP, SCI and SCO
c       'posm'  Generated momentum of decay positron
c       'mcpe'  energy loss in MCP detector
c       'allv'  use all possible NT variables
c       'ltrb'  energy loss in single detectors (inner and outer separate)
c
      integer*4   ntvar(20)   ! new data card defined by CALL FFKEY to
c                             ! select NTuple variables
c
      logical*1   l_init_par  /.false./ 
      logical*1   l_code      /.false./
      logical*1   l_endp      /.false./
      logical*1   l_time      /.false./
      logical*1   l_scip      /.false./
      logical*1   l_scie      /.false./
      logical*1   l_scop      /.false./
      logical*1   l_scoe      /.false./
      logical*1   l_flag      /.false./
      logical*1   l_nhit      /.false./
      logical*1   l_posm      /.false./
      logical*1   l_mcpe      /.false./
      logical*1   l_allv      /.false./
      logical*1   l_ltrb      /.false./
c
c------------------------------------------------------------------
c
c     start of program code
c
c------------------------------------------------------------------
c
c     general initializations
c
c     initial random generator seeds
c
      ix1      = 343156821
c
        do i = 1, 9
                percent(i) = 0
        enddo
c
      l_mcp2   = .false.        
        l_mcpa   = .false.
        l_mcps   = .false.
        l_samp   = .false.
        l_cryo   = .false.
        l_crsh   = .false.
        l_efla   = .false.      
        l_run11  = .false.      
        samp_mat = '    ' 
c
       l_pos   = .false. 
        l_ele   = .false. 
        l_gam   = .false.
c
c-----------------------------------------
c
      call gzebra(NG)
      call hlimit(-NH)
      call ginit    ! initialize GEANT variables
      call gzinit   ! initialize GEANT data structure
      call gpart    ! GEANT standard particles
      call gspart(500, 'muon+', 5, 0.1056584, 1., 2.19703E-6, ub, 1)
c
c------------------------------------------------------------------
c
c     open parfile in any case, the user can decide if data should 
c       be read from parfile or entered by terminal
c
      open(lunin, file=PARFILE, status='OLD',err=1003)
      write(6,*) ' '
      write(6,*) '%GEANT-LEMSR-I- Successfully opened data card file '
      write(6,*)  
      write(6,*) PARFILE
c
c     read data cards
c
      write(6,*) ' '
      write(6,*) 'Type in the data cards now... finish with ''STOP'''
      write(6,*) '--------------------------------------------------'
      write(6,*) ' '
      write(6,*) 'READ 4           :   reads input data from '//
     1           'LUN=4--> file '
        write(6,*) ' '
      write(6,*) PARFILE
      write(6,*) ' '
c      write(6,*) 'RUNG 24          : user run number'
c      write(6,*) ' '
c      write(6,*) 'PLOT 0           : no graphical output'
c      write(6,*) 'PLOT 1           : output on workstation only'
c      write(6,*) 'PLOT 2           : output on workstation and metafile'
c      write(6,*) ' '
c      write(6,*) 'SETS 2 0         : particle is e+(=2), michel '//
c     1            'distributed'
c      write(6,*) '                     start MCP2 detector'
c      write(6,*) 'SETS 2 -74 27 5 1 : beam positron with 27.51 MeV/c '//
c     1           'at z=-74cm'
c      write(6,*) 'SETS 5 -74  2 0 0 : beam muon(=5) with 2.00 MeV/c'
c      write(6,*) '                    particle started 74cm upstream of'
c      write(6,*) '                    of center of MCP2 tube.'
c      write(6,*) ' '
c      write(6,*) 'TRIG 100          : 100 events to be generated'
c      write(6,*) ' '
c      write(6,*) 'GEOM ''mcp2'' ''samp'' : mcp2 and cryo are mounted.'
c      write(6,*) ' '
c      write(6,*) 'SPAR ''  e+'' ''  e-'' '' gam'' : select sec. '// 
c     1           'particles.'
c      write(6,*) ' '
c      write(6,*) 'BFIE 0. 0. 100. 90. :   Sample B-field (Gauss), '//
c     1           'Bx, By, Bz,'
c      write(6,*) '                        and Polarization = 90 % here.'
c      write(6,*)
c      write(6,*) 'NTVA ''init'' ''time'' ''flag'' : define NT '//
c     1           'variables.'
c      write(6,*) 'See geant_lemsr.input for more information.'
c      write(6,*)
c      write(6,*) 'View 1 Thet Phi Psi u0 v0 10*scal_x 10*scal_y : '//
c     1           'for graphical output'
c      write(6,*) 'Def.     60  40   0 10 10         2         2'
c      write(6,*) ' '
c
c---------------------------------------------------------------
c
c     define new data card for particles
c
      call ffkey('SPAR', lspar, 10, 'M')
c
c     define new data card for magnetic field components
c
      call ffkey('BFIE', bfield, 5, 'R')
c
c     define new data card for NTUPLE variables
c
      call ffkey('NTVA', ntvar, 20, 'M')
c
c     read data card
c
      call gffgo
c
      close(lunin)
c
      write(6,*) ' '
      write(6,*) '%GEANT-LEMSR-I- Closed file ', PARFILE
      write(6,*)
c
      write(6,*) 'B-field components Bx, By, Bz = ', bfield(1), 
     1            bfield(2), bfield(3)
      write(6,*) ' '
      write(6,*) 'Initial muon polarization = ', bfield(4),' %.'
      write(6,*)
c
      if ( bfield(1) .ne. 0. ) then
            write(6,*) '******************************************'
            write(6,*) ' '
            write(6,*) 'GEANT-LEMSR-E- B_x  not yet implemented...'
            write(6,*) 'Sorry,   - - - - >  E X I T'
            write(6,*) ' '
            write(6,*) '******************************************'
            call exit
      endif 
      if ( bfield(2) .ne. 0. .and. bfield(3) .ne. 0. ) then
            write(6,*) '******************************************'
            write(6,*) ' '
            write(6,*) 'GEANT-LEMSR-E- B_y >0 and B_z >0  not yet '//
     1                          'implemented...'
            write(6,*) 'Sorry,   - - - - >  E X I T'
            write(6,*) ' '
            write(6,*) '******************************************'
            call exit
      endif
c
      if ( lsets(2) .ne. 0 .and. lsets(7) .ne. 1) then
            write(6,*) ' '
            write(6,*) 'particles of type ',lsets(1),' start at z0 = ',
     1                  lsets(2)
            write(6,*) ' '
      else if ( lsets(7) .eq. 1 ) then
            write(6,*) ' '
            write(6,*) 'particles of type ',lsets(1),' start at z0 '//
     1                 'read from file'
            write(6,*) ' '
      else
            write(6,*) ' '
            write(6,*) 'particles of type ',lsets(1),' start at z0 = '//
     1                 '1.40002 cm.'
            write(6,*) ' '
      endif
c
c-------------------------------------
c
c       look for particles to be created during tracking
c
        ipres = 0
      call glook('  e+',lspar,10,ipres)
      if ( ipres .ne. 0 ) then
            l_pos = .true.
            write(6,*) ' '
            write(6,*) 'secondary particle:  e+...'
      endif
      call glook('  e-',lspar,10,ipres)
      if ( ipres .ne. 0 ) then
            l_ele = .true.
            write(6,*) 'secondary particle:  e-...'
      endif
      call glook(' gam',lspar,10,ipres)
      if ( ipres .ne. 0 ) then
            l_gam = .true.
            write(6,*) 'secondary particle:  gamma...'
      endif
c
c------------------------------------------------------------
c
c       now look for geometrical setup variables
c
      call glook('mcp2',lgeom,20,ipres)
      if ( ipres .ne. 0 ) then
            l_mcp2 = .true.
            write(6,*) 'Setup with:     MCP2'
      endif
c
      call glook('mcpa',lgeom,20,ipres)
      if ( ipres .ne. 0 ) then
            l_mcpa = .true.
            write(6,*) 'Setup with:     MCP2 anode and support ring'
      endif
c
      call glook('ru11',lgeom,20,ipres)
      if ( ipres .ne. 0 ) then
        l_run11 = .true.
        if ( l_mcp2 .or. l_mcpa ) then
          write(6,*) 'Setup with:     MCP2 Run 11 geometry, delay '//
     1               'line anode'
        endif
      else
         if ( l_mcp2 .or. l_mcpa ) then
            write(6,*) 'Setup with:     MCP2 Run 10 geometry, WSZ anode'
         endif
      endif
c
      call glook('mcps',lgeom,20,ipres)
      if ( ipres .ne. 0 ) then
          l_mcps = .true.
          write(6,*) 'Setup with:     MCP2 stainless steel vacuum tube'
      endif    
c
      call glook('samp',lgeom,20,ipres)
      if ( ipres .ne. 0 ) then
          l_samp = .true.
          write(6,*) 'Setup with:     sample holder'
      endif
c
      call glook('saal',lgeom,20,ipres)
      if ( ipres .ne. 0 ) then
          samp_mat = 'saal'
          if ( l_samp ) then
              write(6,*) 'Setup with:     Al - sample holder'
          endif
      else
          if ( l_samp ) then
              write(6,*) 'Setup with:     Cu - sample holder'
          endif
      endif
      call glook('cryo',lgeom,20,ipres)
      if ( ipres .ne. 0 ) then
          l_cryo = .true.
          write(6,*) 'Setup with:     cryostat'
      endif
c
      call glook('crsh',lgeom,20,ipres)
      if ( ipres .ne. 0 ) then
          l_crsh = .true.
          write(6,*) 'Setup with:     He shield'
      endif
c
      call glook('efla',lgeom,20,ipres)
      if ( ipres .ne. 0 ) then
          l_efla = .true.
          write(6,*) 'Setup with:     100 CF flange at the end'
      endif
c
c----------------------------------------------------
c
c       look for NT variables
c
      call glook('init', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_init_par = .true.
          write(6,*) 'NT variable: initial position and momenta.'
      endif
c       
      call glook('code', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_code = .true.
          write(6,*) 'NT variable: Code of primary particle.'
      endif
c       
      call glook('endp', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_endp = .true.
          write(6,*) 'NT variable: End position and end energy of e+.'
      endif
c       
      call glook('time', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_time = .true.
          write(6,*) 'NT variable: t-MCP2 and t-SCI.'
      endif
      call glook('scip', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_scip = .true.
          write(6,*) 'NT variable: Position of particle when '//
     1               'hitting inner Sc..'
      endif
c
      call glook('scie', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_scie = .true.
          write(6,*) 'NT variable: Energy deposited in inner Sc.'
      endif
c       
      call glook('scop', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_scop = .true.
          write(6,*) 'NT variable: Position of particle when '//
     1               'hitting outer Sc..'
      endif
c
      call glook('scoe', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_scoe = .true.
          write(6,*) 'NT variable: Energy deposited in outer Sc.'
      endif
c       
      call glook('flag', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_flag = .true.
          write(6,*) 'NT variable: Volume number and particle codes.'
          write(6,*) 'Note: the Vol. No. is necessary to get '//
     1               'single decay spectra.'
      endif
c       
      call glook('nhit', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_nhit = .true.
          write(6,*) 'NT variable: Hits per Track in MCP, Sci Sco.'
      endif
c
      call glook('posm', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_posm = .true.
          write(6,*) 'NT variable: inital e+ momentum.'
      endif
c       
      call glook('mcpe', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_mcpe = .true.
          write(6,*) 'NT variable: Energy deposited in MCP2.'
      endif
c       
      call glook('allv', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_allv = .true.
          write(6,*) 'NT variable: all variables.'
      endif
c       
      call glook('ltrb', ntvar,20,ipres)
      if ( ipres .ne. 0 ) then
          l_ltrb = .true.
          write(6,*) 'NT variable: energies deposited in single '//
     1               'scintill.'
      endif
c       
c----------------------------------------------------
c
      write(runno,'(I4)',err=1002) idrun         ! copy run number to string
c
      if ( lsets(2) .ne. 0 .and. lsets(7) .ne. 1) then
                if ( lsets(3) .gt. 0 ) then
                    pkine(1) = float(lsets(3)) + float(lsets(4))/10. +
     1                         float(lsets(5))/100.
                else
                    pkine(1) = float(lsets(3)) - float(lsets(4))/10. -
     1                         float(lsets(5))/100.
                endif
          write(6,'(a,1x,f10.4)') ' %GEANT-LEMSR-I- beam momentum '//
     1            'set to ', pkine(1)
      endif
      if ( lsets(6) .ne. 0 ) then
          write(6,*) ' '
          write(6,*) 'Gaussian beam divergence set to (degree) ',
     1       lsets(6)
          write(6,*) ' '
      endif
c
c       define volumes and detectors
c
      call ugeom 
c
c       compute the cross-sections for the different tracking media
c
      call gphysi
c
c       make MARS invisible
c
      call gsatt('MARS','SEEN',0)
c
      call ggclos   ! end of the geometry, must be called 
c
c       print some information about volumes and tracking media on screen
c
c       call gprint('VOLU',0)
c       call gptmed(0)
c       call gpmate(17)
c       call gpmate(18)
c
c-----------------------------------------------------------------------------
c
c       from GEXAM.FOR example :
c
c       the card PLOT is used in the following way:
c       no PLOT card -->        LPLOT(1)=0  --> no graphic output
c       PLOT       1 -->        LPLOT(1)=1  --> plotting onto workstation
c       PLOT       2 -->        LPLOT(1)=2  --> plottinig onto workstation
c                                               and  PostScript file
      if (lplot(1) .gt. 0) then
c
          if ( lview(1) .eq. 1 ) then
                gdtheta = lview(2)
                gdphi   = lview(3)
                gdpsi   = lview(4)
                gdx0    = lview(5)
                gdy0    = lview(6)
                gdsx    = lview(7)/10.
                gdsy    = lview(8)/10.
          else
                gdtheta = 60.
                gdphi   = 40.
                gdpsi   = 0.
                gdx0    = 10.
                gdy0    = 10.
                gdsx    = 0.2
                gdsy    = 0.2
          endif
c
c           
          call iginit(0)              ! init HIGZ
c
c           ask for worktsation type
c           this defines the geometry of the X11 window, according to 
c           HIGZ_WINDOWS.DAT
c
          write(6,'(''0Enter the workstation type : '')')
          read(5,*) iwktyp
          call hplint(iwktyp)
          call igset('2BUF',11.)
c
          if (lplot(1) .gt. 1) then
c
c                       open graphics output file
c
              psfile = OUT_DIR//'geant_lemsr_'//runno//'.ps'
              open(unit=10, file=psfile, status='NEW', 
     1             form='FORMATTED',
     2             access='SEQUENTIAL', err=1001)

                write(6,*) '%GEANT-LEMSR-I- succesfully opened '//
     1            'metafile '
                          write(6,*)
                          write(6,*) psfile
c
c               open and activate workstation for metafile output
c               workstation ID = 5
c               goes to file LUN = 10
c               type = -4112 = PostScript, Landscape, A4 (--> HIGZ manual)
c
                call iopwk(5, 10, -4112)
                call iacwk(5)
c
c               find out and select the appropriate transformation and viewport
c
                call igqwk(5,'MXDS',r)
                xn = min( 1., r(1)/r(2) )
                yn = min( 1., r(2)/r(1) )
                call isvp( 5, 0., xn, 0., yn)
                scal = 20. / min( xn, yn )
                call iswn( 5, 0., scal, 0., scal)
                call iselnt(5)
          endif               ! if LPLOT(1) .GT. 1
c
c           initialize the GEANT's drawing package before the first plot
c
          call gdinit
c
c           draw the chamber 
c
          call gdraw('MARS',gdtheta,gdphi,gdpsi,gdx0,gdy0,gdsx,gdsy)
          call gdaxis(-10.,15.,-20.,8.)
          call gdscal(gdx0, gdy0)
      endif                   ! IF LPLOT(1) .GT. 0
c
c------------------------------------------------------------------------------
c
c       open NTUPLE file and book NTUPLE
c
      ntfile = OUT_DIR//'geant_lemsr_'//runno//'.nt'
c 
      iquest(10) = 65000             ! to allocate enough space for NTUPLE
      call hropen(80,'GEANT',ntfile,'NQ',4096,istat)
      if (istat.eq.0) then
        write(6,*) '%GEANT-LEMSR-I- succesfully opened NTUPLE file '
          write(6,*) ' '
          write(6,*) ntfile
      else
        write(6,'('' %GEANT-LEMSR-E- error opening NTUPLE file '',/,a)')
     1      ntfile
        call exit
      endif
c
c       book CWN
c
      call hbnt(111,'GEANT_LEMSR', 'D')  ! 'D' disk resident NTUPLE
c
c       now define the variable blocks for CWN
c
      if ( l_init_par .or. l_allv ) then
            call hbname(111,'init_par', nt_x0,
     1              'x0:r*4, y0:r*4, z0:r*4,'//
     2              'px0:r*4, py0:r*4, pz0:r*4, p0:r*4')
      endif
c
      if ( l_code .or. l_allv ) then
            call hbname(111,'partcode', nt_ipart, 'Ipart:u*4:9')
      endif
      if ( l_endp .or. l_allv ) then
            call hbname(111,'endpos'  , nt_xe,
     1             'xe:r*4, ye:r*4, ze:r*4, epos:r*4')
      endif
      if ( l_time .or. l_allv ) then
            call hbname(111,'times'   , nt_tmcp, 'tmcp:r*4, tsci:r*4')
      endif
      if ( l_scip .or. l_allv ) then
            call hbname(111,'sci_pos' , nt_xsci,
     1            'xsci:r*4, ysci:r*4, zsci:r*4')
      endif
      if ( l_scie .or. l_allv ) then
            call hbname(111,'sci_elos', nt_desci,
     1            'desci:r*4, descipos:r*4, descigam:r*4, desciele:r*4') 
      endif
c
      if ( l_scop .or. l_allv ) then
            call hbname(111,'sco_pos' , nt_xsco,
     1            'xsco:r*4, ysco:r*4, zsco:r*4')
      endif
      if ( l_scoe .or. l_allv ) then
            call hbname(111,'sco_elos', nt_desco,
     1            'desco:r*4, descopos:r*4, descogam:r*4, descoele:r*4') 
      endif
c
      if ( l_flag .or. l_allv ) then
            call hbname(111,'flags'   , nt_volno, 'volno:u*4:8,'// 
     1               'partcode:u*4:7')
      endif
      if ( l_nhit .or. l_allv ) then
            call hbname(111,'nhits'   , nt_mcpnhits,
     1            'mcpnhits:u*4:8, scinhits:u*4:8, sconhits:u*4:8')
      endif
      if ( l_posm .or. l_allv ) then
          call hbname(111,'pos_mom' , nt_pxpos, 
     1                'pxpos:r*4, pypos:r*4, pzpos:r*4')
      endif
      if ( l_mcpe .or. l_allv ) then
            call hbname(111,'de_mcp'  , nt_demcp, 'demcp:r*4')
      endif
c
      if ( l_ltrb .or. l_allv ) then
          call hbname(111,'de_ltrb'  , nt_descil, 'de_left_i:r*4,'//
     1            'de_top_i:r*4, de_rite_i:r*4, de_bot_i:r*4,'// 
     2            'de_left_o:r*4,'//
     3            'de_top_o:r*4, de_rite_o:r*4, de_bot_o:r*4')
      endif
c
      if ( lsets(7) .eq. 1 ) then     ! read initial data from file
c
          write(6,*) ' '
          write(6,*) ' lsets(7) = 1 ---> I will read data from file ',
     1                INFILE
          open(70, file=INFILE, form='UNFORMATTED', status='OLD',
     1               err=2000)
          write(6,*) ' '
          write(6,*) '%GEANT_LEMSR-I- Successfully opened file ', INFILE
          read(70) nevent
          write(6,*) ' '
          write(6,*) ' Number of events in file = ', nevent
          write(6,*) ' '
      endif
c
c-----------------------------------------------------------------                                                          c
c 
c       E N D        OF       I N I T I A L I S A T I O N                     
c                                                                                                                           c
c-----------------------------------------------------------------
c 
c     now do the tracking
c
      call grun
c
c     update all workstations
c
      if ( lplot(1) .gt. 0 ) call iuwk(0,1)
c
c       accept some input to have time to look at the picture
c
      if ( lplot(1) .gt. 0 ) then
            write(6,*) ' '
            write(6,*) ' type anything to continue '
            read(5,*)
      endif
      if ( lplot(1) .gt. 1 ) then
          call iclwk(5)               ! advance paper
          close(10)
      endif
c
c       end GEANT and HPLOT
c
      call glast
c
      if ( lplot(1) .gt. 0 ) call igend
c
      if ( lsets(7) .eq. 1) then
            close(70)
            write(6,*) ' '
            write(6,*) '%GEANT-LEMSR-I- closed input file ', INFILE
            write(6,*) ' '
      endif
c
c       write data and close NTUPLE file
c
      call hrout(111,i,' ')
      call hrend('GEANT')
      close(80)
      write(6,*) '%GEANT-LEMSR-I- closed NTUPLE file ', ntfile
      write(6,*) '%GEANT-LEMSR-I- results of NEUMANN rejection for '//
     1       'MICHEL spectrum : '
      write(6,'(t10,'' rejected trials : '',i10)') rejcou
      write(6,'(t10,'' succes.  trials : '',i10)') cou
      write(6,*) ' '
      write(6,'(t5,'' RNDM generator seed at the end : '')')
      write(6,'(t10,''    ix1     = '',i15)') ix1
      write(6,*) ' '
      call exit
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c       error messages
c
1000  continue
      write(6,'(''0%GEANT-LEMSR-E- error reading GDRAW parameter...'')')
      call exit
c
1001  continue
      write(6,'(''0%GEANT-LEMSR-E- error opening '',a)') psfile
      call exit
c
1002  continue
      write(6,'(''0%GEANT-LEMSR-E- error write RunNo to string...'')')
      write(6,*) '    may be, you entered a run number with more than '
      write(6,*) '    4 digits...'
      call exit
c
1003  continue
      write(6,'(''0%GEANT-LEMSR-E- error opening input file '',a)') 
     1       PARFILE
      call exit
c
2000  continue
      write(6,*) '%GEANT-LEMSR-E- error opening input file ', INFILE
      call exit
      end
