c------------------------------------------------------------------------------
c       ~/mc/mcv3k/src/read_mcv3k_out_nt.f
c------------------------------------------------------------------------------
c
        program read_mcv3k_out_nt
c
c       program to read the unformatted output file of the MCV3K_TEST program
c       data are written into a ntuple to use PAW to display data
c
c       at the moment the data "format" is
c       12 entries per record
c
c       1.entry      number of particle    I*4
c       2.entry       number of layer       I*4
c       3.-5.entry    x,y,z                 R*4
c       6.-8.entry    px,py,pz              R*4
c       9.entry       kinetic energy        R*4
c       10.entry      theta                 R*4
c       11.entry      phi                   R*4
c       12.entry      total time            R*4
c
c       at the moment particle data at the exit of seven layers are written
c       to the data file (the name must be FOR0##.DAT); 
c
c       TP, PSI, 13-jun-1995
c
c       TP, 26-jun-1995:    modified number of NTUPLE entries for
c                           use in analysing of the piE5 data
c
c       TP, 27-jun-1995:    modified again number of ntuple entries
c                           only the data in front of the last layer are
c                           selected to minimize file space
c                           there is a little error now: the first entry
c                           of the NTUPLE will be ID=1 and all other variables
c                           equal to 0, if the first ID read from file is not
c                           1
c                           prompt now for the input file name without extension
c                           ( the default extension is .DAT !). the root file 
c                           name will be used to create the output filename 
c                           with the extension .NT
c
c       TP, 10-Aug-1995:    read filename without extension from command
c                           line using the CLI$GET_VALUE function
c
c       TP, 30-Jan-1996:    read initial and final data from file, so, add data
c                           to NTUPLE 
c
c       TP, 30-Jan-1996:    changed back        
c       TP, 13-Sep-2000:    changed to run on Windows NT 4.0 and Unix
c
c------------------------------------------------------------------------------
c
      implicit none                ! inquire variable definition
c
      character*80    fname        ! string containing filename without
      integer*4       length       ! extension and length
c
      integer*4   id, il       ! particle and layer number
      real*4      x,y,z,px,py,pz,ekin ! location, momentum and energy of 
c                                     ! particle
      real*4      theta, phi,time     ! direction angulars and total time of
c                                     ! flight
c
c     for the NTUPLE
c
c     first declarations for the initialisation of the HBOOK package
c
      integer*4	   MAXPAGES
      parameter   (MAXPAGES = 1000)
      integer*4   ipawc(128 * MAXPAGES)
c
      common  /pawc/ ipawc
c
      integer*4    iquest(100)
      common /quest/iquest  !needed to get enough space for NTUPLE
c
c     for handling the NTUPLE file
c
      integer*4    lunin /20/, lunnt /21/ ,istat
      character*80 infile, ntfile
c       
c     for booking and filling of the NTUPLE
c
      integer*4  nvar, nprime
c     parameter    nvar = 71           !number of variables in NTUPLE
      parameter    (nvar = 11)           !number of variables in NTUPLE
      parameter    (nprime = 1000)       !NPRIME words are allocated
      character*8  tags(nvar)                    !short name of each variable
      real*4       xtup(nvar)                    !array with the current data
c                                                                        !points
      data         tags 
     1  / 'ID',
     2  'X0', 'Y0', 'Z0', 'PX0', 'PY0', 'PZ0', 'E0', 'TH0', 'PH0', 'T0'/
c     3 'X1', 'Y1', 'Z1', 'PX1', 'PY1', 'PZ1', 'E1', 'TH1', 'PH1', 'T1'/
c     5 'X2', 'Y2', 'Z2', 'PX2', 'PY2', 'PZ2', 'E2', 'TH2', 'PH2', 'T2'/
c     6 'X3', 'Y3', 'Z3', 'PX3', 'PY3', 'PZ3', 'E3', 'TH3', 'PH3', 'T3'/
c     7 'X4', 'Y4', 'Z4', 'PX4', 'PY4', 'PZ4', 'E4', 'TH4', 'PH4', 'T4',
c     8 'X5', 'Y5', 'Z5', 'PX5', 'PY5', 'PZ5', 'E5', 'TH5', 'PH5', 'T5',
c     9 'X6', 'Y6', 'Z6', 'PX6', 'PY6', 'PZ6', 'E6', 'TH6', 'PH6', 'T6'
c     1  /
c
c       other variables
c
      integer*4    temp, n, i
      logical*1    cont
c
c-----------------------------------------------------------------------------  
c
c     read first the filename for data input from an MCV3K run and make
c     the NTUPLE filename
c 
      write(6,'(/,$,a)')
     1 'Enter the filename with the MCV3K data without extension : '
        read(5,'(a)') fname
      call str_trim (fname, length)
c
c     write(6,'('' length of string = '',i)') length
c
      infile = fname(1:length)//'.dat'
      ntfile = fname(1:length)//'.nt'
c
c     open input file
c
      open (lunin, file=infile, status = 'OLD', form = 'UNFORMATTED', 
     1   err= 1)
      goto 2
1     continue
      write(6,'('' %OPEN_MCV3K-E- error opening input file '',a)') 
     1 infile
      call exit
2     continue
      write(6,'('' %OPEN_MCV3K-I- successfully opened input file '',a)') 
     1 infile
c       
c     initialize HBOOK
c
      call hlimit ( 128 * MAXPAGES )
c
c     open NTUPLE file and book NTUPLE
c
      iquest(10) = 65000             ! to allocate enough space for the NTUPLE
c
      call hropen(lunnt,'MCV3K',ntfile,'NQ',4096,istat)
c
      if (istat.eq.0) then   ! everything is all right
      	write(6,
     1 '('' %READ_MCV3K-I- succesfully opened NTUPLE file '',a)') ntfile
      else
      	write(6,'('' %READ_MCV3K-E- error opening NTUPLE file '',a)')
     1                ntfile
        call exit
      endif
c
      call hbookn(111,'MCV3KDAT',nvar,'//MCV3K',nprime,tags)
c
      temp = 1  ! initialize the temporary storage with the
c                         ! the first particle number
      id   = 1
      n    = 0
c
c     endless loop on reading the file and filling the ntuple
c
      do while ( .true. )
c
            xtup(1) = temp
            cont    = .true.
c
            do while ( cont )   ! read until a particle is lost
c                               ! then, the array XTUP will be written
c                               ! into the NTUPLE, and then XTUP will
c                               ! be cleared and the data of the next
c                               ! particle will be read
c 
              read(lunin,err=11,end=10) id,il,x,y,z,px,py,pz,ekin,theta,
     1                                  phi,time
c             write(6,'(I6,2x,I3,10f10.3)') id,il,x,y,z,px,py,pz,
c     1                                    ekin,theta,phi,time
c
c           copy data into the ntuple array xtup
c
                if ( id .eq. temp) then     ! still data from one particle
c
                    xtup( 2  + n*10 ) = x
                    xtup( 3  + n*10 ) = y
                    xtup( 4  + n*10 ) = z
                    xtup( 5  + n*10 ) = px
                    xtup( 6  + n*10 ) = py
                    xtup( 7  + n*10 ) = pz
                    xtup( 8  + n*10 ) = ekin
                    xtup( 9  + n*10 ) = theta
                    xtup( 10 + n*10 ) = phi
                    xtup( 11 + n*10 ) = time
                    n = n + 1
                else
                    call hfn (111, xtup)
c
c                   reset the xtup array to be ready for the next particle
c
                    do i = 1, nvar
                                xtup (i) = 0.
                    enddo
c
c                   we just read the initial paramter of the following
c                   particle, so, write them to the XTUP array
c
                    xtup( 2 ) = x
                    xtup( 3 ) = y
                    xtup( 4 ) = z
                    xtup( 5 ) = px
                    xtup( 6 ) = py
                    xtup( 7 ) = pz
                    xtup( 8 ) = ekin
                    xtup( 9 ) = theta
                    xtup( 10) = phi
                    xtup( 11) = time
                    temp = id
                    cont = .false.
                    n = 1
                endif 
            enddo
c
      enddo
10    write(6,'('' Succesfully read data from file '',a)')  infile
      close (lunin)
      call hfn (111, xtup)            ! save also data from the last particle
      call end_ntuple( lunnt, ntfile )
      call exit
11    write(6,'('' Error during reading...'')')
      close (lunin)
      call end_ntuple( lunnt, ntfile )
      call exit
c
      end
c
c------------------------------------------------------------------------------
c
        subroutine end_ntuple(lunnt, ntfile)
c
c       routine to close the ntuple file 
c
        implicit none
c
        integer*4     lunnt                         ! LUN of Ntuple file
        character*(*) ntfile
        integer*4     i
c
c------------------------------------------------------------------------------
c
        call hrout (111, i, ' ')
        call hrend ('MCV3K')
        close (lunnt)
        write(6,'('' %READ_MCV3K-I- closed NTUPLE file '',a,/)') ntfile
        return
        end
c
c------------------------------------------------------------------------------
c
        subroutine str_trim(string, length)
c
c       routine to get the length of string without blanks
c
        implicit none
c
        character*(*)   string
        integer*4               i, length
c
        i = 1
        do while (string(i:i) .ne. ' ')
                i = i + 1
        enddo
        length = i-1
        return
        end
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c       EOF READ_MCV3K_OUT.FOR
