      program ERRSUM2
!
! Summarize errors listed in ICOOL log file FOR002.DAT
!
      character(80) line
!
      version = 1.10
!
      open(unit=2,file='for002.dat',status='old',iostat=ioc)
      if( ioc .ne. 0 ) then
        write(*,*) 'Cant find input file  FOR002.DAT'
        go to 900
      end if
      open(unit=3,file='errsum2.dat',status='unknown')
      write(3,'(a,f8.2)') 'Welcome to ERRSUM2  version',version
      write(*,'(a,f8.2)') 'Welcome to ERRSUM2  version',version
!
100   continue
      read(2,'(a80)',iostat=ioc) line 
      if( ioc .gt. 0 ) then
        write(*,*) 'Error reading input line'
        write(*,'(a80)') line
        go to 900
      else if( ioc .lt. 0 ) then            ! eof
        go to 500
      end if
      if( line(2:8) .ne. 'FAILURE' ) go to 100
      read(line(46:47),'(i2)') ierr
      read(line(48:55),'(i8)') ievt
      read(line(72:79),'(i8)') ireg
      call ORGANIZE(ierr,ievt,ireg)
      go to 100     
!
500   continue          ! finish processing
      call MESSAGES
      call SUMMARY
!
900   continue
      write(*,*) 'Read file  ERRSUM2.DAT  for further details'
      end
! *********************************************************
      block data
      common/DAT/err1,reg1,evt1,nerr,nreg,nevt,nert,nrgt,nfail
      integer nert(100),nrgt(1000)
      integer err1(100,3,10),reg1(1000,3,10),evt1(3,20)
      common/EMSG/msg
      character(40) msg(100)
!
      data nerr/0/,nreg/0/,nevt/0/,nert/100*0/,nrgt/1000*0/
      data nfail/0/
      data msg/100*' '/
      end
! *********************************************************
      subroutine MESSAGES
      common/EMSG/msg
      character(40) msg(100)
!
      msg(10) = 'Particle outside dipole aperture'
      msg(11) = 'Got unphysical momentum from dipole edge'
      msg(12) = 'Negative argument in SQRT in DERIV'
      msg(13) = 'Error setting internal Lz correlation'
      msg(14) = 'Unphysical momentum from random kick'
      msg(15) = 'Removed by ICOOL cut'
      msg(16) = 'Error setting internal dispersion'
      msg(23) = 'Exceeded maximum radius'
      msg(24) = 'Failure of Fano scattering model'
      msg(25) = 'Illegal LOG arg in dEdx'
      msg(26) = 'Failure of Tollestrup scattering model'
      msg(27) = 'Illegal LOG arg in scatter'
      msg(28) = 'Exceeded aperture limit'
      msg(29) = 'Probability error in RESTRICT_LOSS'
      msg(30) = 'Error in muon decay'
      msg(31) = 'Exceeded max radius in tapered solenoid'
      msg(32) = 'Vz went negative'
      msg(33) = 'Stuck in stepping loop'
      msg(36) = 'Particle time difference > BUNCHCUT'
      msg(39) = 'Exceeded max radius in ACCEL region'
      msg(40) = 'Exceeded max radius in TAPERED ROD'
      msg(43) = 'Pz of particle < PZMINTRK'
      msg(47) = 'Exceeded max radius in KICKER region'
      msg(52) = 'Particle decayed'
      msg(57) = 'Radius larger than cavity radius'
      msg(58) = 'Failed hemispherical window logic'
      msg(61) = 'Momentum outside band for induction linac'
      msg(62) = 'Spin tracking error'
      msg(64) = 'Depolarization error in spin tracking'
      msg(72) = 'Radius too large in helix field'
      msg(73) = 'Hadron had inelastic interaction'
      msg(74) = 'Argument out of range in Bessel I0 or I1'
      msg(75) = 'Argument out of range in Bessel K0 or K1'
      msg(76) = 'Stepping gave r > 100 m or pt > 1000 GeV/c'
      msg(77) = 'Reference particles gave same time'
      msg(81) = 'Interpolated horn point lies outside grid'
      msg(82) = 'Position error in DIPOLE model 4'
      msg(85) = 'Failure in Moliere scattering algorithm'
      msg(86) = 'Unphysical solenoid end kick'
      msg(87) = 'Unphysical momentum from TRANSPORT'
!
      end
! *********************************************************
      subroutine ORGANIZE(ierr,ievt,ireg)
!
! Organize data into ordered tables
!
      common/DAT/err1,reg1,evt1,nerr,nreg,nevt,nert,nrgt,nfail
      integer nert(100),nrgt(1000)
      integer err1(100,3,10),reg1(1000,3,10),evt1(3,20)
!
! Find total number of times each error type occurred
! List first 10 failures for each error type
      do i=1,nerr
      if( ierr .eq. err1(i,3,1) ) then
        err1(i,3,2) = err1(i,3,2) + 1
        nfail = nfail + 1
        nert(i) = nert(i) + 1
        if( nert(i) .le. 10 ) then
          err1(i,1,nert(i)) = ievt
          err1(i,2,nert(i)) = ireg
        else
          nert(i) = 10
        end if
        go to 100
      end if
      end do
! New error type
      nerr = nerr + 1
      if( nerr .gt. 100 ) nerr = 100
      err1(nerr,3,1) = ierr
      err1(nerr,3,2) = 1
      nfail = nfail + 1
      nert(nerr) = 1
      err1(i,1,nert(nerr)) = ievt
      err1(i,2,nert(nerr)) = ireg
!
100   continue
!
! Find total number of failures in regions with failures
! List first 10 failures for each region with failures
      do i=1,nreg
      if( ireg .eq. reg1(i,3,1) ) then
        reg1(i,3,2) = reg1(i,3,2) + 1
        nrgt(i) = nrgt(i) + 1
        if( nrgt(i) .le. 10 ) then
          reg1(i,1,nrgt(i)) = ierr
          reg1(i,2,nrgt(i)) = ievt
        else
          nrgt(i) = 10
        end if
        go to 200
      end if
      end do
! New failed region
      nreg = nreg + 1
      if( nreg .gt. 1000 ) nreg = 1000
      reg1(nreg,3,1) = ireg
      reg1(nreg,3,2) = 1
      nrgt(nreg) = 1
      reg1(i,1,nrgt(nreg)) = ierr
      reg1(i,2,nrgt(nreg)) = ievt
!
200   continue
!
! List first 20 failures
      nevt = nevt + 1
      if( nevt .gt. 20 ) then
        nevt = 20
        go to 300
      end if
      evt1(1,nevt) = ireg
      evt1(2,nevt) = ievt
      evt1(3,nevt) = ierr
!
300   continue
!
      end
! *********************************************************
      subroutine SUMMARY
!
! Print out summary table
!
      common/DAT/err1,reg1,evt1,nerr,nreg,nevt,nert,nrgt,nfail
      integer nert(100),nrgt(1000)
      integer err1(100,3,10),reg1(1000,3,10),evt1(3,20)
      common/EMSG/msg
      character(40) msg(100)
!
      write(3,*)
      write(3,*) 'Failure type summary'
      write(3,"(t12,'fail #',t22,'times')")
      write(*,*) 'Failure type summary'
      write(*,"(t12,'fail #',t22,'times')")
      do i=1,nerr
      k = err1(i,3,1)
      write(3,"(t10,i6,t20,i6,t40,a40)") k,err1(i,3,2),msg(k)
      write(*,"(t10,i6,t20,i6,t40,a40)") k,err1(i,3,2),msg(k)
      end do
      write(3,'(a,t20,i6)') 'TOTAL',nfail
      write(*,'(a,t20,i6)') 'TOTAL',nfail
!
      write(3,*)
      write(3,*) 'Failed regions summary'
      write(3,"(t12,'region',t22,'failures')")
      do i=1,nreg
      write(3,"(t10,i6,t20,i6)") reg1(i,3,1),reg1(i,3,2)
      end do
!
      write(3,*)
      write(3,*) 'First 20 failures'
      write(3,"(t12,'reg',t22,'evt',t32,'err')")
      do i=1,nevt
      write(3,"(t10,i6,t20,i6,t30,i6)") (evt1(j,i),j=1,3)
      end do
!
      write(3,*)
      write(3,*) 'Failure type: first 10 occurrences'
      write(3,"(t12,'fail #',t22,'region',t32,'event')")
      do i=1,nerr
      do j=1,nert(i)
      if( j .eq. 1) then
        write(3,100) err1(i,3,1),err1(i,2,j),err1(i,1,j)
100     format(t10,i6,t20,i6,t30,i6)
      else
        write(3,105) err1(i,2,j),err1(i,1,j)
105     format(t20,i6,t30,i6)
      end if
      end do
      write(3,*)
      end do
!
      write(3,*)
      write(3,*) 'Failed regions: first 10 occurrences'
      write(3,"(t12,'region',t22,'event',t32,'fail #')")
      do i=1,nreg
      do j=1,nrgt(i)
      if( j .eq. 1) then
        write(3,100) reg1(i,3,1),reg1(i,2,j),reg1(i,1,j)
      else
        write(3,105) reg1(i,2,j),reg1(i,1,j)
      end if
      end do
      write(3,*)
      end do
!
      end