      SUBROUTINE JBGTRK(icase)
      integer icase

C+SEQ, GCKINE.
      COMMON /GCKINE/ IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP,
     +    NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
c                      
      COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(30),NAMEC(30)  
     + ,NSTEP ,MAXNST,DESTEP,DESTEL,SAFETY,SLENG ,STEP  ,SNEXT ,SFIELD   
     + ,TOFG  ,GEKRAT,UPWGHT,IGNEXT,INWVOL,ISTOP ,IGAUTO,IEKBIN, ILOSL   
     + , IMULL,INGOTO,NLDOWN,NLEVIN,NLVSAV,ISTORY        

      COMMON/GCKING/KCASE,NGKINE,GKIN(5,100),TOFD(100),IFLGK(100)          

      COMMON/GCVOLU/NLEVEL,NAMES(15),NUMBER(15),
     +LVOLUM(15),LINDEX(15),INFROM,NLEVMX,NLDEV(15),LINMX(15),
     +GTRAN(3,15),GRMAT(10,15),GONLY(15),GLX(3)
      INTEGER NLEVEL,NAMES,NUMBER,LVOLUM,LINDEX,INFROM,NLEVMX,
     +        NLDEV,LINMX
      REAL GTRAN,GRMAT,GONLY,GLX

      COMMON/GCKIN3/GPOS(3,100)

      COMMON/GCSETS/IUSET,IUDET,ISET,IDET,IDTYPE,NVNAME,NUMBV(20)        
      COMMON/GCTMED/ NUMED,NATMED(5),ISVOL,IFIELD,FIELDM,TMAXFD,DMAXMS, 
     +  DEEMAX,EPSIL,STMIN,CFIELD,CMULS,IUPD,ISTPAR,NUMOLD           
      COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN,     
     +          IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2)      

      integer inode,iprin,j

      integer mnode
      parameter(mnode=10000)
      real v(mnode,7)
      real oldvect(7)
      integer cnode,curvol,daught(mnode),vol(mnode),hit(mnode)
      integer med(mnode)
      integer pred(mnode),prevvol
      logical lexit
      common/trkhst/cnode,med,v,daught,vol,hit,pred,
     >     oldvect,prevvol
      include 'jbgsav.inc'


c      print *,'in ',lvolum(nlevel)

      if(icase.eq.1)then  !initialize run
c
         lentry=.false.
         ievnt=0
         do i=1,400
            do j=1,3
               actvol(j,i)=.false.
            enddo
         enddo
         actvol(1,1)=.true.    !   WRLD
c  
      elseif(icase.eq.2)then  !initialize event
         lentry=.false.
         cnode=0
         oldvol=0
         oldmed=0
         ievnt=ievnt+1
c         print *,'ievnt =',ievnt
         do i=1,7
            oldvect(i)=0.
         enddo
         prevvol=1
c
      elseif(icase.eq.3)then  !track the event
         lentry=.false.
         lexit=.false.

c         if(ievnt.eq.61)then
c         endif
c
c     decide whether we need a new node or not
c     if entering or leaving an active volume or
c     particle is stopping or we have entered
c     a score plane then yes
c
c     find active volume
         do i=nlevel,1,-1
c     print *,i,lvolum(i),actvol(1,lvolum(i))
            if(actvol(1,lvolum(i)).and..not.actvol(3,lvolum(i)))then
               curvol=lvolum(i)
               goto 10
            elseif(actvol(3,lvolum(i)).and.i.eq.nlevel)then
               curvol=lvolum(i)
               goto 10
            endif
         enddo
 10      continue
c     print *,'curvol=',curvol,oldvol,istop,numed,inwvol
c     
         if(actvol(2,curvol).and.inwvol.eq.1
     >        .and..not.actvol(2,oldvol))then
            lentry=.true.
         endif
c     
         if(.not.actvol(2,curvol).and.actvol(2,oldvol))then
            lexit=.true.
         endif
c
         if(oldvol.ne.curvol.or.istop.ne.0.or.
     >        lentry.or.lexit)then
c
c     make a new node 
c
            cnode=cnode+1
            if(cnode.gt.mnode)then
               print *,'ERROR: cnode=',cnode
               cnode=cnode-1
               return
            endif
            
            do i=1,7
               v(cnode,i)=vect(i)
            enddo
            if(lentry)then
               curvol=lvolum(nlevel)
               hit(cnode)=1
c               print *,'there was a hit'
            else
               hit(cnode)=0
            endif
            daught(cnode)=1
            vol(cnode)=curvol
            med(cnode)=numed
            pred(cnode)=0
            oldvol=curvol
            oldmed=numed
            
         endif
         
c     
c     if particle has stopped then print it, delete free nodes.
c     
         if(istop.ne.0)then  
            daught(cnode)=daught(cnode)-1
c     
            if(daught(cnode)+ngkine.eq.0)then
               do j=1,cnode
                  if(hit(j).eq.1.and.pred(j).eq.0)then
                     if(pred(1).eq.0)then
c                        print *,' '
c                        print *,' Here is an entirely new event '
c                        print *,ievnt
                     endif
c                     print *,'----------------------'
                     do inode=cnode,1,-1
c                        write(*,30)pred(inode),inode,vol(inode),
c     >                       (v(inode,i),i=1,7)
                        pred(inode)=1
                     enddo
                     goto 20
                  endif
               enddo
            endif
 30         format(i1,1x,i3,1x,i3,1x,3(f7.1,1x),3(f5.2,1x),f9.3)
c     
 20         if(cnode.eq.0)return
            if(daught(cnode)+ngkine.eq.0)then
               cnode=cnode-1
               daught(cnode)=daught(cnode)-1
               oldvol=vol(cnode)
               oldmed=med(cnode)
               goto 20
            endif
         endif
c     
         
      elseif(icase.eq.6)then    !put secondary on the stack
         daught(cnode)=daught(cnode)+1
      elseif(icase.eq.4)then  !end event
c         print *,'jbgtrk 4: cnode = ',cnode
      elseif(icase.eq.5)then  ! end run
      elseif(icase.eq.7)then  !load the primary and far hit variables
         primhit=1
         do inode=1,cnode
            if(vol(inode).ne.1)then
               primhit=vol(inode)
               goto 51
            endif
         enddo
 51      continue
         zmax=0.
         do inode=1,cnode
            if(abs(v(inode,3)).gt.zmax.and.vol(inode).ne.1)then
               zmax=abs(v(inode,3))
               farhit=vol(inode)
            endif
         enddo
      endif

      avez=(vect(3)+oldvect(3))/2.
      oldr=sqrt(oldvect(1)**2+oldvect(2)**2)
      newr=sqrt(vect(1)**2+vect(2)**2)
      aver=(newr+oldr)/2.0
      difr=(newr-oldr)/2.0

c      if(abs(vect(3)).lt.51.0.and.abs(newr-20.).lt.2.)then

c         write(*,31)ikine,istak,lvolum(nlevel),
c     >        (vect(i),i=1,7),sqrt(vect(1)**2+vect(2)**2)
c 31      format(i1,1x,i3,1x,i3,1x,3(f7.1,1x),
c     >        3(f5.2,1x),f9.3,1x,f5.2)

c      endif

c      do i=1,cnode
c         print *,i,vol(i),daught(i),hit(i)
c      enddo
c      print *,'out',cnode,daught(cnode),hit(cnode)
c
      return                                                                  
      END

      subroutine jbgset(type,vol)
      implicit none
      include 'jbgsav.inc'
      integer type,vol

      print *,'jbgset',type,vol

      if(type.eq.1.or.type.eq.2)actvol(1,vol)=.true.
      if(type.eq.2)actvol(2,vol)=.true.
      if(type.eq.3)actvol(3,vol)=.true.

      print *,actvol(1,vol),actvol(2,vol)

      return
      end

