c**************************************************
      subroutine besior(iirun,iorarg)    
c**************************************************
      integer iorarg(10),usearg(10)
      common/usearg/usearg  
      do i=1,10
        usearg(i) = iorarg(i)
      end do
c   
c   iorarg(1-10) are transferred to besevn   
c
      call beshis
      return    
      end   
c**************************************************
      subroutine besevn(iirec,evnarg)
c****************************************************
* iorarg                                            *
*        (3-10) = cuts used in besel*               *
c****************************************************
c
      include 'rawdat.inc'
      include 'trklst.inc'  
      include 'evlst.inc'   
      include 'trk5pt.inc'  
      include 'nsquid.inc'  
      include 'ppp.inc'
      integer evnarg(10),need(10)
      common/usearg/usearg  
      integer usearg(10)
c
czj      if( usearg(1).eq.0.and.usearg(2).eq.0.and.
czj     &    usearg(3).eq.0 ) return
c
c        do the following things only for 'not bad' event
      if( nchrgx.ne.0.or.tottks.le.1 ) return
      if( irun.le.15200 ) return
c
*
*        event selection and statistics
*   
      do in=1,10
        need(in)=0
      end do
      call besel4(iirec,need(4))
*
*        physics analysis
*
c   note! the following is only used in one kind of readily selected 
c   events (not mixed selection), otherwise do analysis in besel* !
c
c----------------------------------------------------------------
c        log out event
      if ( usearg(1).eq.1 ) then
        if( need(1).gt.0.or.need(4).gt.0 ) then
          call evlog(istat)
        endif
      endif
c
      return    
      end   
c
c**************************************************
      subroutine beseor(iirun,eorarg)    
c**************************************************
c
      include 'rawdat.inc'
      include 'trklst.inc'  
      include 'evlst.inc'   
      include 'trk5pt.inc'  
      include 'nsquid.inc'  
      include 'ppp.inc'
      include 'pawc.inc'
      include 'tofwgt.inc'
      include 'partid.inc'
      integer eorarg(10)
      common/usearg/usearg(10)  
      integer usearg
c
      call hisout
c
      return    
      end   
c
c**************************************************
      subroutine besel4(iirec,ndsel)
c*******************************************************************
c   
c     bes evt. selection 4 ( J/Psi --> K+,K-,gamma )
c                                                               
c                                                S. Jin  93-03-12
c                               Modified by  Guo Zijin   99-07-19    
c*******************************************************************
c     
      include 'rawdat.inc'
      include 'trklst.inc'  
      include 'evlst.inc'   
      include 'ectof.inc'   
      include 'runprm.inc'   
      include 'trk5pt.inc'  
      include 'nsquid.inc'  
      include 'ppp.inc'
      include 'pawc.inc'
      include 'tofwgt.inc' 
      include 'partid.inc'
c
      common/usearg/usearg  
      integer usearg(10)
c
      logical newsquid
      logical oksq
      external newsquid
      external vmax,vmin,lvmin,theta12,phi12,phi
      integer*4 ivs
      integer*4 rc,npart,nres,pspec(4,20),pmem(20),mem(20)
      real*4 pfit(4,20),mass(20),mres(20)
      dimension var_cut(69)
      dimension escn(20),scfx(20),scfy(20),scfz(20),
     *          scosx(20),scosy(20),scosz(20),rscf(20),rscd(20),
     *          thdf(20),thmf(20),thmd(20),idg(20),
     *          thpf1(20),thpd1(20),thpf2(20),thpd2(20),
     *          phih(20),phif(20),phid(20),phdh(20),phdf(20),
     *          phhf(20),phmh(20),phmf(20),phph1(20),phph2(20),
     *          phpf1(20),phpf2(20),phpd1(20),phpd2(20),thvf(20),
     *          nscl(20),nfscl(20),ntht(20),wmax(20),width(6)
      dimension escn_g(20),
     *          scfx_g(20),scfy_g(20),scfz_g(20),
     *          scosx_g(20),scosy_g(20),scosz_g(20),
     *          rscf_g(20),rscd_g(20),cos_g(10),
     *          thdf_g(20),thmf_g(20),thmd_g(20),idg_g(20),
     *          thpf1_g(20),thpd1_g(20),thpf2_g(20),thpd2_g(20),
     *          phif_g(20),phdh_g(20),phdf_g(20),
     *          phmh_g(20),phmf_g(20),phph1_g(20),phph2_g(20),
     *          phpf1_g(20),phpf2_g(20),phpd1_g(20),phpd2_g(20),
     *          thvf_g(20),thvfcm_g(20),thvfcm1_g(20),
     *          nscl_g(20),nfscl_g(20)
      dimension chi2_g(20),pfg_g(20),phmg_f(20),thmg_f(20),
     *          thvg_f(20),fmkk(20),rq2mg_f(20),cosg_f(20),
     *          epms_f(20),cospf1_cm(20),cospf2_cm(20),
     *          fmgk1(20),fmgk2(20)
      dimension scfx_sg(20),scfy_sg(20),scfz_sg(20),rscf_sg(20),
     *          escn_sg(20),idg_sg(20),nscl_sg(20),nfscl_sg(20)
      dimension rq2mf(20),rq2md(20),rq2mf_g(20),rq2md_g(20)
      dimension chi2_p(200),api0_p(200),rmgg_p(200),rmdif_p(200),
     *          api0_cm(200),thgg_p(200),egdif_p(200),
     *          chi2_p1(200),chi2_p2(200),chi2_p3(200),
     *          chi2_p4(200),chi2_p5(200),chi2_p6(200),
     *          chi2_p7(200),chi2_p8(200),chi2_p9(200),
     *          rmpi01(200),rmpi02(200),rmpi03(200),
     *          rmpi04(200),rmpi05(200),rmpi06(200),
     *          rmpi07(200),rmpi08(200),rmpi09(200),
     *          rmkk07(200),rmkk08(200),rmkk09(200),
     *          rmks107(200),rmks108(200),rmks109(200),
     *          rmks207(200),rmks208(200),rmks209(200)
c
      real rmpi0,ppi0(4),plab1(4),plab2(4),pcm1(4),pcm2(4)
      real plabpp1(4),plabpp2(4),pcmpp1(4),pcmpp2(4),pp_cm(4),
     *     p_cmpp1(4),p_cmpp2(4)
      real plabjsi(4),pcmjsi(4)
      real plabg(4),pcmg(4),thmfcm_g(20),thpf1cm_g(20),thpf2cm_g(20),
     *     phmfcm_g(20)
      integer pid1,pid2
c
      real thetv1(20),thetv2(20),thetam(20),phim(20)
      real ppx1(20),ppy1(20),ppz1(20),ee1(20),amass1(20)
      real ppx2(20),ppy2(20),ppz2(20),ee2(20),amass2(20)
      real ppx3(20),ppy3(20),ppz3(20),ee3(20),amass3(20)
c
      rmprton=0.93827
      rmkoan=0.4936
      rmpi=0.1396
      rmpi0=0.13497
c   initialize imod,imod_g
      do i=1,20
        idg(i)=0
        idg_g(i)=0
      end do
c   initialize var_cut,escn,scfx,scfy,scfz,...
c
c   initialize cos_g
      do i=1,10
        cos_g(i)=2.0
      end do
      do j=1,20
        chi2_g(j)=200000.0
        cosg_f(j)=2.0
        cospf1_cm(j)=2.0
        cospf2_cm(j)=2.0
        nscl(j)=0
        ntht(j)=0
        wmax(j)=0.0
        nfscl(j)=100
        nscl_g(j)=0
        nfscl_g(j)=100
        nscl_sg(j)=0
        nfscl_sg(j)=100
      end do
      do k=1,200
        chi2_p(k) =2000000.0
        chi2_p1(k)=2000000.0
        chi2_p2(k)=2000000.0
        chi2_p3(k)=2000000.0
        chi2_p4(k)=2000000.0
        chi2_p5(k)=2000000.0
        chi2_p6(k)=2000000.0
        chi2_p7(k)=2000000.0
        chi2_p8(k)=2000000.0
        chi2_p9(k)=2000000.0
        rmpi01(k) =2000000.0
        rmpi02(k) =2000000.0
        rmpi03(k) =2000000.0
        rmpi04(k) =2000000.0
        rmpi05(k) =2000000.0
        rmpi06(k) =2000000.0
        rmpi07(k) =2000000.0
        rmpi08(k) =2000000.0
        rmpi09(k) =2000000.0 
        rmkk07(k) =2000000.0                   
        rmkk08(k) =2000000.0                   
        rmkk09(k) =2000000.0         
        rmks107(k) =2000000.0                   
        rmks108(k) =2000000.0                   
        rmks109(k) =2000000.0         
        rmks207(k) =2000000.0                   
        rmks208(k) =2000000.0                   
        rmks209(k) =2000000.0         
        api0_p(k) =2000000.0
        api0_cm(k)=2000000.0
        rmdif_p(k)=2000000.0
        thgg_p(k)=200.0
        egdif_p(k)=0.0
      end do
      chi2minp=2000000.0
      chi2minp1=2000000.0
      chi2minp2=2000000.0
      chi2minp3=2000000.0
      chi2minp4=2000000.0
      chi2minp5=2000000.0
      chi2minp6=2000000.0
      chi2minp7=2000000.0   
      chi2minp8=2000000.0   
      chi2minp9=2000000.0   
      rmpi01m = 999.
      rmpi02m = 999.
      rmpi03m = 999.
      rmpi04m = 999.
      rmpi05m = 999.
      rmpi06m = 999.
      rmpi07m = 999.        
      rmpi08m = 999. 
      rmpi09m = 999.
      rmkk07m = 999.     
      rmkk08m = 999. 
      rmkk09m = 999.
      rmks107m = 999.     
      rmks108m = 999. 
      rmks109m = 999.
      rmks207m = 999.     
      rmks208m = 999. 
      rmks209m = 999.
      chi2ming=200000.0
      thedif1=20000.0
      thedif2=2000.0
c
      x1time1 = 99999.
      x1time2 = 99999.
      x1time3 = 99999.
      x1timee1 = 99999.
      x1timee2 = 99999.
      x1timee3 = 99999.
      x1timeoff1 = 99999.
      x1timeoff2 = 99999.
      x1timeoff3 = 99999.
      x1timesig1 = 99999.
      x1timesig2 = 99999.
      x1timesig3 = 99999.
      x2time1 = 99999.
      x2time2 = 99999.
      x2time3 = 99999.
      x2timee1 = 99999.
      x2timee2 = 99999.
      x2timee3 = 99999.
      x2timeoff1 = 99999.
      x2timeoff2 = 99999.
      x2timeoff3 = 99999.
      x2timesig1 = 99999.
      x2timesig2 = 99999.
      x2timesig3 = 99999.
      x1xsp1 = 99999.
      x1xsp2 = 99999.
      x1xsp3 = 99999.
      x1dedxoff1 = 99999.
      x1dedxoff2 = 99999.
      x1dedxoff3 = 99999.
      x1dedxsig1 = 99999.
      x1dedxsig2 = 99999.
      x1dedxsig3 = 99999.
      x2xsp1 = 99999.
      x2xsp2 = 99999.
      x2xsp3 = 99999.
      x2dedxoff1 = 99999.
      x2dedxoff2 = 99999.
      x2dedxoff3 = 99999.
      x2dedxsig1 = 99999.
      x2dedxsig2 = 99999.
      x2dedxsig3 = 99999.
      IDFLAG1 = 99999.
      IDFLAG2 = 99999.
      IDdFLAG1 = 99999.
      IDdFLAG2 = 99999.
      IDGDTOF1 = 99999.
      IDGDDEDX1 = 99999.
      IDGDCOM1 = 99999.
      IDGDTOF2 = 99999.   
      IDGDDEDX2 = 99999.  
      IDGDCOM2 = 99999.   
c
      ndsel=0    ! ndsel has been initialized by need(*) besevn
c
      if(irun.le.0)                     ivs=103
      if(irun.ge.462.and.irun.le.961)   ivs=5
      if(irun.ge.1248.and.irun.le.1616) ivs=6
      if(irun.ge.1750.and.irun.le.2045) ivs=8
      if(irun.ge.3579.and.irun.le.3739) ivs=7
      if(irun.ge.13000)                 ivs=103
c
      call jpsi_run_status(irun,istatus)
      if(istatus.eq.3)return
c
      call ncor
c
c   total charge of this event
      itotch=0
      if( tottks.gt.20.or.tottks.lt.3 ) return
c
      nmdc = 0  
      do 50 i1 = 1, nchrg
        isub1=trksub(1,i1)
        if(isub1.le.0) goto 50
        itype = itrk(isub1+5)
        idc = ibits(itype,0,1)
        if(idc.eq.0) goto 50
        itotch=itotch+itrk(trksub(1,i1)+4)
        nmdc = nmdc +1
   50 continue  
c
      if( itotch.ne.0.or.nmdc.ne.2 ) return
c
      rx1=0.0
      ry1=0.0
      rz1=0.0
      r1=0.0
      rx2=0.0
      ry2=0.0
      rz2=0.0
      r2=0.0
      px1=0.0
      py1=0.0
      pz1=0.0
      pp1=0.0
      phi1=0.0
      px2=0.0
      py2=0.0
      pz2=0.0
      pp2=0.0
      phi2=0.0
c
      tscf=0.0
      tscos=0.0
      rextbsc=999.0
      rextbtf=999.0
      rextesc=999.0
      rextetf=999.0
c
      scfpx1=999.0
      scfpy1=999.0
      scfpz1=999.0
      rscfp1=999.0
      scfpx2=999.0
      scfpy2=999.0
      scfpz2=999.0
      rscfp2=999.0
c
      scospx1=999.0
      scospy1=999.0
      scospz1=999.0
      rscosp1=999.0
      scospx2=999.0
      scospy2=999.0
      scospz2=999.0
      rscosp2=999.0
c
      iscflgp1=-5
      iscflgp2=-5
c
      pid1=0
      pid2=0
      nnp1=0
      nnp2=0
      nnnp1=0
      nnnp2=0
      wtk1=99.
      wtk2=99.
c
c ! charged tracks
      ngtrk=0
c
      do 100 i2=1,nchrg
        i2sub1=trksub(1,i2)
        if(i2sub1.le.0) goto 100
        i2type = itrk(i2sub1+5)
        i2dc = ibits(i2type,0,1)
        if(i2dc.eq.0) goto 100
c
	ind3=trksub(3,i2)
	ind4=trksub(4,i2)
	ind5=trksub(5,i2)
	ind6=trksub(6,i2)
	ind7=trksub(7,i2)
	ind11=trksub(11,i2)
        if( ind3.eq.0.and.ind4.eq.0.and.ind5.eq.0
     &      .and.ind6.eq.0 ) return
c
	if( ind3.ne.0 ) then
c   
c   good track selection
c
          rch2=trk(ind3+17)
          nmfit=itrk(ind3+14)
          if( nmfit.ne.2 ) goto 100
c
c   track from primary vertex (only for 2_prong events)
c
          rx=trk(ind3+10)
          ry=trk(ind3+11)
          rz=trk(ind3+12)
          rxy=sqrt(rx*rx+ry*ry)
          arz=abs(rz)
c
          if( rxy.gt.0.02.or.abs(rz).gt.0.20) goto 100
c   total # of good charged tracks from oringal in this event
          ngtrk=ngtrk+1
c   for charge "+" track
	  if( itrk(ind3+2).eq.1 ) then
            ipid1=i2
	    px1=trk(ind3+4)
	    py1=trk(ind3+5)
	    pz1=trk(ind3+6)
	    pp1=trk(ind3+7)
            pxy1=sqrt(px1**2+py1**2)
            phi1=trk(ind3+9)
            rx1=trk(ind3+10)
            ry1=trk(ind3+11)
            rz1=trk(ind3+12)
c        de/dx
            if( ind7.ne.0 ) then
              rnhit1=float(itrk(ind7+3))
              rsfe1=trk(ind7+15)
              rsfmu1=trk(ind7+16)
              rsfpi1=trk(ind7+17)
              rsfk1=trk(ind7+18)
              rsfp1=trk(ind7+19)
            else
              rnhit1=0.0
              rsfpi1=-10.0
              rsfp1=-100.0
            endif
c   tof & dE/dx
c---Particle ID
            call tofpid(i2,IFLAG,1)
            IDFLAG1 = IFLAG
      if(IDFLAG1.ne.0) then
      x1time1  = xtime(1)
      x1time2  = xtime(2)
      x1time3  = xtime(3)
      x1timee1 = xtimee(1)
      x1timee2 = xtimee(2)
      x1timee3 = xtimee(3)
      x1timeoff1  = xtimeoff(1)
      x1timeoff2  = xtimeoff(2)
      x1timeoff3  = xtimeoff(3)
      x1timesig1  = xtimesig(1)
      x1timesig2  = xtimesig(2)
      x1timesig3  = xtimesig(3)
      endif
c
           call partid(i2,IFLAG,1)
            IDdFLAG1 = IFLAG
            IDGDTOF1 = IDGDTOF
            IDGDDEDX1 = IDGDDEDX
            IDGDCOM1 = IDGDCOM
      if(IDGDDEDX1.ne.0) then
      x1xsp1  = xxsp(1)  
      x1xsp2  = xxsp(2)  
      x1xsp3  = xxsp(3)  
      x1dedxoff1  = xdedxoff(1)
      x1dedxoff2  = xdedxoff(2)
      x1dedxoff3  = xdedxoff(3)
      x1dedxsig1  = xdedxsig(1)
      x1dedxsig2  = xdedxsig(2)
      x1dedxsig3  = xdedxsig(3)
      endif
c 
            if( ind4.ne.0 ) then
              icnt11=itrk(ind4+3)
              icnt12=itrk(ind4+20)
              if( icnt11.ne.0 ) then
                icnt1=icnt11
                tof1=trk(ind4+4)  
                beta1=trk(ind4+5)
                tq1=trk(ind4+8)
                wtpi1=trk(ind4+9)
                wtk1=trk(ind4+10)
                wtp1=trk(ind4+11)
                wte1=trk(ind4+12)
                amsq1=trk(ind4+13)
                path1=trk(ind4+14)
                terr1=trk(ind4+15)  
              else if( icnt12.ne.0 ) then
                icnt1=icnt12
                tof1=trk(ind4+21)
                beta1=trk(ind4+22)
                tq1=trk(ind4+25)
                wtpi1=trk(ind4+26)
                wtk1=trk(ind4+27)
                wtp1=trk(ind4+28)
                wte1=trk(ind4+29)
                amsq1=trk(ind4+30)
                path1=trk(ind4+31)
                terr1=trk(ind4+32)
              else
                icnt1=0
                tof1=999.0
                beta1=9.99
                tq1=-2.
                wtpi1=0.
                wtk1=99.
                wtp1=0.
                wte1=0.
                amsq1=999.0
                path1=999.0
                terr1=999.0
              endif
            else
              icnt1=0
              tof1=999.
              beta1=9.99
              tq1=-2.
              wtpi1=0.
              wtk1=99.0
              wtp1=0.
              wte1=0.
              amsq1=999.0
              path1=999.0
              terr1=999.0
            endif
            if( ind4.gt.0.and.tq1.le.8.and.path1.lt.999.0.and.
     *          tof1.gt.0.and.beta1.lt.9.0.and.beta1.gt.0.0.and.
     *          (icnt11.gt.0.and.icnt11.le.48 ) ) then
              if (wtk1.gt.wte1.and.wtk1.gt.wtpi1.and.wtk1.gt.wtp1) 
     *          then
                pid1=5
              else if (wtk1.gt.wte1.and.wtk1.gt.wtpi1 )
     *          then
                pid1=51
              else if ( wtpi1.ge.wtk1.or.wte1.ge.wtk1 )
     *          then
                pid1=4
              endif
            else if( rsfk1.gt.-3.0.and.rnhit1.gt.20.0.
     *               and.abs(rsfk1).lt.abs(rsfe1).
     *               and.abs(rsfk1).lt.abs(rsfmu1).
     *               and.abs(rsfk1).lt.abs(rsfpi1).
     *               and.abs(rsfk1).lt.abs(rsfp1) )
     *        then
              pid1=52
            else if( rsfpi1.le.3.0.and.rnhit1.gt.20.0.
     *               and.abs(rsfpi1).lt.abs(rsfk1))
     *        then
              pid1=42
            endif
c        shower counter 
            if( ind5.gt.0.and.itrk(ind5+20).eq.1 ) then
              tscf=sqrt(trk(ind5+4)**2+trk(ind5+6)**2+
     *                  trk(ind5+8)**2)
              tscos=sqrt(trk(ind5+27)**2+trk(ind5+28)**2)
            else
              tscf=0.0
              tscos=0.0
            endif
            if( ind11.gt.0 ) then
              rextbsc=sqrt(trk(ind11+8)**2+trk(ind11+9)**2+
     *                     trk(ind11+10)**2)
              rextbtf=sqrt(trk(ind11+2)**2+trk(ind11+3)**2+
     *                     trk(ind11+4)**2)
              rextesc=sqrt(trk(ind11+20)**2+trk(ind11+21)**2+
     *                     trk(ind11+22)**2)
              rextetf=sqrt(trk(ind11+14)**2+trk(ind11+15)**2+
     *                     trk(ind11+16)**2)
            else
              rextbsc=999.0
              rextbtf=999.0
              rextesc=999.0
              rextetf=999.0
            endif
            if( ind5.gt.0.and.itrk(ind5+20).eq.1.and.
     *          tscf.gt.0.0.and.tscf.lt.10.0.and.
     *          tscos.gt.0.0.and.tscos.le.1.0 ) then
              nmod1=itrk(ind5+20)
              rmod1=float(nmod1)
              esc1=trk(ind5+14)
              scfpx1=trk(ind5+4)
              scfpy1=trk(ind5+6)
              scfpz1=trk(ind5+8)
              rscfp1=sqrt(scfpx1**2+scfpy1**2+scfpz1**2)
              phip1=phi(scfpx1,scfpy1)
              scospx1=trk(ind5+27)
              scospy1=trk(ind5+28)
              scospz1=trk(ind5+29)
              rscosp1=sqrt(scospx1**2+scospy1**2+scospz1**2)
              phiscp1=phi(scospx1,scospy1)
              iscflgp1=0
            else
              nmod1=5
              rmod1=5.0
              esc1=0.0
              if( ind11.gt.0 ) then
                if( rextbsc.gt.0.0.and.rextbsc.lt.900.0 ) then
                  scfpx1=trk(ind11+8)
                  scfpy1=trk(ind11+9)
                  scfpz1=trk(ind11+10)
                  rscfp1=sqrt(scfpx1**2+scfpy1**2+scfpz1**2)
                  phip1=phi(scfpx1,scfpy1)
                  thextrp=trk(ind11+11)
                  phextrp=trk(ind11+12)
                  scospx1=sin(thextrp)*cos(phextrp)
                  scospy1=sin(thextrp)*sin(phextrp)
                  scospz1=cos(thextrp)
                  rscosp1=sqrt(scospx1**2+scospy1**2+scospz1**2)
                  phiscp1=phextrp
                  iscflgp1=1
                else if( rextbtf.gt.0.0.and.rextbtf.lt.900.0 ) then
                  scfpx1=trk(ind11+2)
                  scfpy1=trk(ind11+3)
                  scfpz1=trk(ind11+4)
                  rscfp1=sqrt(scfpx1**2+scfpy1**2+scfpz1**2)
                  phip1=phi(scfpx1,scfpy1)
                  thextrp=trk(ind11+5)
                  phextrp=trk(ind11+6)
                  scospx1=sin(thextrp)*cos(phextrp)
                  scospy1=sin(thextrp)*sin(phextrp)
                  scospz1=cos(thextrp)
                  rscosp1=sqrt(scospx1**2+scospy1**2+scospz1**2)
                  phiscp1=phextrp
                  iscflgp1=2
                else if( rextesc.gt.0.0.and.rextesc.lt.900.0 ) then
                  scfpx1=trk(ind11+20)
                  scfpy1=trk(ind11+21)
                  scfpz1=trk(ind11+22)
                  rscfp1=sqrt(scfpx1**2+scfpy1**2+scfpz1**2)
                  phip1=phi(scfpx1,scfpy1)
                  thextrp=trk(ind11+23)
                  phextrp=trk(ind11+24)
                  scospx1=sin(thextrp)*cos(phextrp)
                  scospy1=sin(thextrp)*sin(phextrp)
                  scospz1=cos(thextrp)
                  rscosp1=sqrt(scospx1**2+scospy1**2+scospz1**2)
                  phiscp1=phextrp
                  iscflgp1=3
                else if( rextetf.gt.0.0.and.rextetf.lt.900.0 ) then
                  scfpx1=trk(ind11+14)
                  scfpy1=trk(ind11+15)
                  scfpz1=trk(ind11+16)
                  rscfp1=sqrt(scfpx1**2+scfpy1**2+scfpz1**2)
                  phip1=phi(scfpx1,scfpy1)
                  thextrp=trk(ind11+17)
                  phextrp=trk(ind11+18)
                  scospx1=sin(thextrp)*cos(phextrp)
                  scospy1=sin(thextrp)*sin(phextrp)
                  scospz1=cos(thextrp)
                  rscosp1=sqrt(scospx1**2+scospy1**2+scospz1**2)
                  phiscp1=phextrp
                  iscflgp1=4
                else
                  scfpx1=999.0
                  scfpy1=999.0
                  scfpz1=999.0
                  rscfp1=999.0
                  scospx1=999.0
                  scospy1=999.0
                  scospz1=999.0
                  rscosp1=999.0
                  phiscp1=999.0
                  iscflgp1=-1
                endif
              else
                scfpx1=999.0
                scfpy1=999.0
                scfpz1=999.0
                rscfp1=999.0
                scospx1=999.0
                scospy1=999.0
                scospz1=999.0
                rscosp1=999.0
                phiscp1=999.0
                iscflgp1=-2
              endif
            endif
c        muon chamber 
            if( ind6.ne.0 ) then
              idmu1=itrk(ind6+2)
              rdmu1=float(idmu1)
              imst1=itrk(ind6+3)
              imht1=ibits(imst1,0,1)+ibits(imst1,1,1)
     &             +ibits(imst1,2,1)
              rmht1=float(imht1)
            else
              idmu1=4
              rdmu1=4.0
              rmht1=-2.0
            endif
c   for charge "-" track
          else if( itrk(ind3+2).eq.-1 ) then
            ipid2=i2
	    px2=trk(ind3+4)
	    py2=trk(ind3+5)
	    pz2=trk(ind3+6)
	    pp2=trk(ind3+7)
            pxy2=sqrt(px2**2+py2**2)
            phi2=trk(ind3+9)
            rx2=trk(ind3+10)
            ry2=trk(ind3+11)
            rz2=trk(ind3+12)
c        de/dx
            if( ind7.ne.0 ) then
              rnhit2=float(itrk(ind7+3))
              rsfe2=trk(ind7+15)
              rsfmu2=trk(ind7+16)
              rsfpi2=trk(ind7+17)
              rsfk2=trk(ind7+18)
              rsfp2=trk(ind7+19)
            else
              rnhit2=0.0
              rsfpi2=-10.0
              rsfp2=-100.0
            endif
c   tof & dE/dX 
c---Particle ID
            call tofpid(i2,IFLAG,1)
            IDFLAG2 = IFLAG
      if(IDFLAG2.ne.0) then
      x2time1  = ytime(1)
      x2time2  = ytime(2)
      x2time3  = ytime(3)
      x2timee1 = ytimee(1)
      x2timee2 = ytimee(2)
      x2timee3 = ytimee(3)
      x2timeoff1  = ytimeoff(1)
      x2timeoff2  = ytimeoff(2)
      x2timeoff3  = ytimeoff(3)
      x2timesig1  = ytimesig(1)
      x2timesig2  = ytimesig(2)
      x2timesig3  = ytimesig(3)
      endif
c
           call partid(i2,IFLAG,1)
            IDdFLAG2 = IFLAG
            IDGDTOF2 = IDGDTOF
            IDGDDEDX2 = IDGDDEDX
            IDGDCOM2 = IDGDCOM
      if(IDGDDEDX2.ne.0) then
      x2xsp1  = yxsp(1)  
      x2xsp2  = yxsp(2)  
      x2xsp3  = yxsp(3)  
      x2dedxoff1  = ydedxoff(1)
      x2dedxoff2  = ydedxoff(2)
      x2dedxoff3  = ydedxoff(3)
      x2dedxsig1  = ydedxsig(1)
      x2dedxsig2  = ydedxsig(2)
      x2dedxsig3  = ydedxsig(3)
      endif
c
            if( ind4.ne.0 ) then
              icnt21=itrk(ind4+3)
              icnt22=itrk(ind4+20)
              if( icnt21.ne.0 ) then
                icnt2=icnt21
                tof2=trk(ind4+4)  
                beta2=trk(ind4+5)
                tq2=trk(ind4+8)
                wtpi2=trk(ind4+9)
                wtk2=trk(ind4+10)
                wtp2=trk(ind4+11)
                wte2=trk(ind4+12)
                amsq2=trk(ind4+13)
                path2=trk(ind4+14)
                terr2=trk(ind4+15)  
              else if( icnt22.ne.0 ) then
                icnt2=icnt22
                tof2=trk(ind4+21)
                beta2=trk(ind4+22)
                tq2=trk(ind4+25)
                wtpi2=trk(ind4+26)
                wtk2=trk(ind4+27)
                wtp2=trk(ind4+28)
                wte2=trk(ind4+29)
                amsq2=trk(ind4+30)
                path2=trk(ind4+31)
                terr2=trk(ind4+32)
              else
                icnt2=0
                tof2=999.0
                beta2=9.99
                tq2=-2.
                wtpi2=0.
                wtk2=99.
                wtp2=0.
                wte2=0.
                amsq2=999.0
                path2=999.0
                terr2=999.0
              endif
            else
              icnt2=0
              tof2=999.
              beta2=9.99
              tq2=-2.
              wtpi2=0.
              wtk2=99.
              wtp2=0.
              wte2=0.
              amsq2=999.0
              path2=999.0
              terr2=999.0
            endif
            if( ind4.gt.0.and.tq2.le.8.and.path2.lt.999.0.and.
     *          tof2.gt.0.and.beta2.lt.9.0.and.beta2.gt.0.0.and.
     *          (icnt21.gt.0.and.icnt21.le.48 ) ) then
              if (wtk2.gt.wte2.and.wtk2.gt.wtpi2.and.wtk2.gt.wtp2) 
     *          then
                pid2=5
              else if (wtk2.gt.wte2.and.wtk2.gt.wtpi2) 
     *          then
                pid2=51
              else if (wtpi2.ge.wtk2.or.wte2.ge.wtk2) 
     *          then
                pid2=4
              endif
            else if( rsfk2.gt.-3.0.and.rnhit2.gt.20.0.
     *               and.abs(rsfk2).lt.abs(rsfe2).
     *               and.abs(rsfk2).lt.abs(rsfmu2).
     *               and.abs(rsfk2).lt.abs(rsfpi2).
     *               and.abs(rsfk2).lt.abs(rsfp2) )
     *        then
              pid2=52
            else if( rsfpi2.le.3.0.and.rnhit2.gt.20.0.
     *               and.abs(rsfpi2).lt.abs(rsfk2))
     *        then
              pid2=42
            endif
c        shower counter
            if( ind5.gt.0.and.itrk(ind5+20).eq.1 ) then
              tscf=sqrt(trk(ind5+4)**2+trk(ind5+6)**2+
     *                  trk(ind5+8)**2)
              tscos=sqrt(trk(ind5+27)**2+trk(ind5+28)**2)
            else
              tscf=0.0
              tscos=0.0
            endif
c
            if( ind11.gt.0 ) then
              rextbsc=sqrt(trk(ind11+8)**2+trk(ind11+9)**2+
     *                     trk(ind11+10)**2)
              rextbtf=sqrt(trk(ind11+2)**2+trk(ind11+3)**2+
     *                     trk(ind11+4)**2)
              rextesc=sqrt(trk(ind11+20)**2+trk(ind11+21)**2+
     *                     trk(ind11+22)**2)
              rextetf=sqrt(trk(ind11+14)**2+trk(ind11+15)**2+
     *                     trk(ind11+16)**2)
            else
              rextbsc=999.0
              rextbtf=999.0
              rextesc=999.0
              rextetf=999.0
            endif
            if( ind5.gt.0.and.itrk(ind5+20).eq.1.and.
     *          tscf.gt.0.0.and.tscf.lt.10.0.and.
     *          tscos.gt.0.0.and.tscos.le.1.0 ) then
              nmod2=itrk(ind5+20)
              rmod2=float(nmod2)
              esc2=trk(ind5+14)
              scfpx2=trk(ind5+4)
              scfpy2=trk(ind5+6)
              scfpz2=trk(ind5+8)
              rscfp2=sqrt(scfpx2**2+scfpy2**2+scfpz2**2)
              phip2=phi(scfpx2,scfpy2)
              scospx2=trk(ind5+27)
              scospy2=trk(ind5+28)
              scospz2=trk(ind5+29)
              rscosp2=sqrt(scospx2**2+scospy2**2+scospz2**2)
              phiscp2=phi(scospx2,scospy2)
              iscflgp2=0
            else
              nmod2=5
              rmod2=5.0
              esc2=0.0
              if( ind11.gt.0 ) then
                if( rextbsc.gt.0.0.and.rextbsc.lt.900.0 ) then
                  scfpx2=trk(ind11+8)
                  scfpy2=trk(ind11+9)
                  scfpz2=trk(ind11+10)
                  rscfp2=sqrt(scfpx2**2+scfpy2**2+scfpz2**2)
                  phip2=phi(scfpx2,scfpy2)
                  thextrp=trk(ind11+11)
                  phextrp=trk(ind11+12)
                  scospx2=sin(thextrp)*cos(phextrp)
                  scospy2=sin(thextrp)*sin(phextrp)
                  scospz2=cos(thextrp)
                  rscosp2=sqrt(scospx2**2+scospy2**2+scospz2**2)
                  phiscp2=phextrp
                  iscflgp2=1
                else if( rextbtf.gt.0.0.and.rextbtf.lt.900.0 ) then
                  scfpx2=trk(ind11+2)
                  scfpy2=trk(ind11+3)
                  scfpz2=trk(ind11+4)
                  rscfp2=sqrt(scfpx2**2+scfpy2**2+scfpz2**2)
                  phip2=phi(scfpx2,scfpy2)
                  thextrp=trk(ind11+5)
                  phextrp=trk(ind11+6)
                  scospx2=sin(thextrp)*cos(phextrp)
                  scospy2=sin(thextrp)*sin(phextrp)
                  scospz2=cos(thextrp)
                  rscosp2=sqrt(scospx2**2+scospy2**2+scospz2**2)
                  phiscp2=phextrp
                  iscflgp2=2
                else if( rextesc.gt.0.0.and.rextesc.lt.900.0 ) then
                  scfpx2=trk(ind11+20)
                  scfpy2=trk(ind11+21)
                  scfpz2=trk(ind11+22)
                  rscfp2=sqrt(scfpx2**2+scfpy2**2+scfpz2**2)
                  phip2=phi(scfpx2,scfpy2)
                  thextrp=trk(ind11+23)
                  phextrp=trk(ind11+24)
                  scospx2=sin(thextrp)*cos(phextrp)
                  scospy2=sin(thextrp)*sin(phextrp)
                  scospz2=cos(thextrp)
                  rscosp2=sqrt(scospx2**2+scospy2**2+scospz2**2)
                  phiscp2=phextrp
                  iscflgp2=3
                else if( rextetf.gt.0.0.and.rextetf.lt.900.0 ) then
                  scfpx2=trk(ind11+14)
                  scfpy2=trk(ind11+15)
                  scfpz2=trk(ind11+16)
                  rscfp2=sqrt(scfpx2**2+scfpy2**2+scfpz2**2)
                  phip2=phi(scfpx2,scfpy2)
                  thextrp=trk(ind11+17)
                  phextrp=trk(ind11+18)
                  scospx2=sin(thextrp)*cos(phextrp)
                  scospy2=sin(thextrp)*sin(phextrp)
                  scospz2=cos(thextrp)
                  rscosp2=sqrt(scospx2**2+scospy2**2+scospz2**2)
                  phiscp2=phextrp
                  iscflgp2=4
                else
                  scfpx2=999.0
                  scfpy2=999.0
                  scfpz2=999.0
                  rscfp2=999.0
                  scospx2=999.0
                  scospy2=999.0
                  scospz2=999.0
                  rscosp2=999.0
                  phiscp2=999.0
                  iscflgp2=-1
                endif
              else
                scfpx2=999.0
                scfpy2=999.0
                scfpz2=999.0
                rscfp2=999.0
                scospx2=999.0
                scospy2=999.0
                scospz2=999.0
                rscosp2=999.0
                phiscp2=999.0
                iscflgp2=-2
              endif
            endif
c        muon chamber
            if( ind6.ne.0 ) then
              idmu2=itrk(ind6+2)
              rdmu2=float(idmu2)
              imst2=itrk(ind6+3)
              imht2=ibits(imst2,0,1)+ibits(imst2,1,1)
     &             +ibits(imst2,2,1)
              rmht2=float(imht2)
            else
              idmu2=4
              rdmu2=4.0
              rmht2=-2.0
            endif
          endif
        endif
100   continue
c
      if( ngtrk.ne.nmdc ) return
c
      if( esc1.ge.1.0.or.esc2.ge.1.0 ) return
c
      if ( pp1.le.0.or.pp2.le.0.or.pp1.ge.2.or.pp2.ge.2. ) return 
c
      tofk1=path1*sqrt(rmkoan**2+pp1**2)*10/(pp1*3)
      tofk2=path2*sqrt(rmkoan**2+pp2**2)*10/(pp2*3)
      tofpi1=path1*sqrt(rmpi**2+pp1**2)*10/(pp1*3)
      tofpi2=path2*sqrt(rmpi**2+pp2**2)*10/(pp2*3)
      if( tof1.lt.999.0.and.tof2.le.999.0.and.
     *    tof1.gt.0.0.and.tof2.gt.0.0.and.
     *    path1.lt.999.0.and.path2.lt.999.0 ) then
        rdelt=tof1+tof2-0.5*(tofk1+tofk2+tofpi1+tofpi2)
      else
        rdelt=10000.0
      endif
      tdpi1=tof1-path1*sqrt(0.1396**2+pp1**2)*10/(pp1*3)
      tdpi2=tof2-path2*sqrt(0.1396**2+pp2**2)*10/(pp2*3)
      tdk1=tof1-path1*sqrt(0.4936**2+pp1**2)*10/(pp1*3)
      tdk2=tof2-path2*sqrt(0.4936**2+pp2**2)*10/(pp2*3)
      tdp1=tof1-path1*sqrt(0.9383**2+pp1**2)*10/(pp1*3)
      tdp2=tof2-path2*sqrt(0.9383**2+pp2**2)*10/(pp2*3)
c
      if( wtk1.le.0.0.or.wtk1.ge.1.0 ) then
        tsk1=999.0
      else
        tsk1=abs(tk1)/sqrt(-2.0*log(wtk1))
      endif
      if( wtk2.le.0.0.or.wtk2.ge.1.0 ) then
        tsk2=999.0
      else
        tsk2=abs(tk2)/sqrt(-2.0*log(wtk2))
      endif
c
      pp1_sav=pp1
      pp2_sav=pp2
      pp1_old=pp1
      pp2_old=pp2
c
c     rmp=0.93827
      e1_old=sqrt(pp1_old**2+rmkoan**2)
      e2_old=sqrt(pp2_old**2+rmkoan**2)
      ett_old=e1_old+e2_old
      ems_old=3.0969-ett_old
c
      e1_pi=sqrt(pp1_old**2+0.1396**2)
      e2_pi=sqrt(pp2_old**2+0.1396**2)
      ett_pi=e1_pi+e2_pi
      ems_pi=3.0969-ett_pi
c
      pxms_old=-px1-px2
      pyms_old=-py1-py2
      pzms_old=-pz1-pz2
      pms_old=sqrt(pxms_old**2+pyms_old**2+pzms_old**2)
      if( pms_old.le.0.0 ) return
c  for rho-pi    
      sqmrho1=(e1_pi+sqrt(pms_old**2+0.135**2))**2-(px1+pxms_old)**2-
     *           (py1+pyms_old)**2-(pz1+pzms_old)**2
      if( sqmrho1.lt.0.0 ) return
      rmrho1=sqrt(sqmrho1)
      sqmrho2=(e2_pi+sqrt(pms_old**2+0.135**2))**2-(px2+pxms_old)**2-
     *           (py2+pyms_old)**2-(pz2+pzms_old)**2
      if( sqmrho2.lt.0.0 ) return
      rmrho2=sqrt(sqmrho2)
c
      epms_old=ems_old-pms_old
c   find 1st vertex
      call vxkwik(stat,0)
      rx0=trk(vrtsub(2,1)+5)
      ry0=trk(vrtsub(2,1)+6)
      rz0=trk(vrtsub(2,1)+7)
ccc      rx0 = 0.
ccc      ry0 = 0.
ccc      rz0 = 0.
c
      scfpx1=scfpx1-rx0
      scfpy1=scfpy1-ry0
      scfpz1=scfpz1-rz0
      scfpx2=scfpx2-rx0
      scfpy2=scfpy2-ry0
      scfpz2=scfpz2-rz0
ccmidsl4 --- 'find' information quickly for too long subroutine
      rcth1=pz1/pp1
      rcth2=pz2/pp2
      thp1=acos(rcth1)
      thp2=acos(rcth2)
c!!!!!
c  1) use beam_pipe (de/dx) correction ( function bpcorr ) ---- 93-10-16
c  2) change trklst after correction ---- 93-10-18
c  3) make a constant correction for each run circle --- 93-10-20
      cnstcorr=1.00
      if( irun.le.1000.and.irun.ge.0 ) then
        cnstcorr=1.00
      else
        cnstcorr=1.00
      endif
c
      pp1=cnstcorr*pp1_sav
      iptp1=trksub(3,ipid1)
      trk(iptp1+3)=trk(iptp1+3)*pp1/trk(iptp1+7)
      trk(iptp1+4)=trk(iptp1+4)*pp1/trk(iptp1+7)
      trk(iptp1+5)=trk(iptp1+5)*pp1/trk(iptp1+7)
      trk(iptp1+6)=trk(iptp1+6)*pp1/trk(iptp1+7)
      trk(iptp1+7)=trk(iptp1+7)*pp1/trk(iptp1+7)
      pp1=trk(iptp1+7)
      px1=trk(iptp1+4)
      py1=trk(iptp1+5)
      pz1=trk(iptp1+6)
c
      pp2=cnstcorr*pp2_sav
      iptp2=trksub(3,ipid2)
      trk(iptp2+3)=trk(iptp2+3)*pp2/trk(iptp2+7)
      trk(iptp2+4)=trk(iptp2+4)*pp2/trk(iptp2+7)
      trk(iptp2+5)=trk(iptp2+5)*pp2/trk(iptp2+7)
      trk(iptp2+6)=trk(iptp2+6)*pp2/trk(iptp2+7)
      trk(iptp2+7)=trk(iptp2+7)*pp2/trk(iptp2+7)
      pp2=trk(iptp2+7)
      px2=trk(iptp2+4)
      py2=trk(iptp2+5)
      pz2=trk(iptp2+6)
c
      e1=sqrt(pp1*pp1+rmkoan**2)
      e2=sqrt(pp2*pp2+rmkoan**2)
      ett=e1+e2
      ems=3.0969-ett
c
c   collinear angle 
      thkk=theta12(px1,py1,pz1,px2,py2,pz2)
c   direction of ... ppbar plane
      vndx = py1*pz2-pz1*py2
      vndy = pz1*px2-px1*pz2
      vndz = px1*py2-py1*px2
c   missing p
      pxms=-px1-px2
      pyms=-py1-py2
      pzms=-pz1-pz2
      pms=sqrt(pxms*pxms+pyms*pyms+pzms*pzms)
      if( pms.le.0.0 ) return
      phms=phi(pxms,pyms)
      epms=ems-pms
      cospms=pzms/pms
      thpm1=theta12(px1,py1,pz1,pxms,pyms,pzms)
      thpm2=theta12(px2,py2,pz2,pxms,pyms,pzms)
      phpm1=phi12(phi1,phms)
      phpm2=phi12(phi2,phms)
c   inv. mass of kk
      sqmkk=ett**2-pxms**2-pyms**2-pzms**2
      if( sqmkk.lt.0.0 ) return
      rmkk=sqrt(sqmkk)
c   for kstar-k
      sqmkstar1=(e1+sqrt(pms**2+0.135**2))**2-(px1+pxms)**2-
     *           (py1+pyms)**2-(pz1+pzms)**2
      if( sqmkstar1.lt.0.0 ) return
      rmkstar1=sqrt(sqmkstar1)
      sqmkstar2=(e2+sqrt(pms**2+0.135**2))**2-(px2+pxms)**2-
     *           (py2+pyms)**2-(pz2+pzms)**2
      if( sqmkstar2.lt.0.0 ) return
      rmkstar2=sqrt(sqmkstar2)
c
      rmj=3.097
      pexp1=0.0
      pexp2=0.0
      sqp1=(rmj**2-(rmkstar2+rmkoan)**2)*(rmj**2-(rmkstar2-rmkoan)**2)
      if( sqp1.ge.0.0 ) then
        pexp1=sqrt(sqp1)/(2*rmj)
      endif
      sqp2=(rmj**2-(rmkstar1+rmkoan)**2)*(rmj**2-(rmkstar1-rmkoan)**2)
      if( sqp2.ge.0.0 ) then
        pexp2=sqrt(sqp2)/(2*rmj)
      endif
c
c!!!!! for 2pn evts.-- for the consistancy between mc and data
czj   if( thkk.ge.175.0 ) return
c
      if( rmkk.ge.3.1 ) return
c
c   remove multi-pion evts
      if( (epms.ge.0.5.or.epms.le.-0.5).and.irun.ge.0 ) return
c
      plabpp1(1)=px1
      plabpp1(2)=py1
      plabpp1(3)=pz1
      plabpp1(4)=sqrt(rmkoan**2+pp1**2)
      plabpp2(1)=px2
      plabpp2(2)=py2
      plabpp2(3)=pz2
      plabpp2(4)=sqrt(rmkoan**2+pp2**2)
      pp_cm(1)=-pxms
      pp_cm(2)=-pyms
      pp_cm(3)=-pzms
      pp_cm(4)=ett
      call lab_cm(rmkk,pp_cm,plabpp1,p_cmpp1)
      thp1_cm=theta12(p_cmpp1(1),p_cmpp1(2),p_cmpp1(3),
     *                pp_cm(1),pp_cm(2),pp_cm(3))
      cosp1_cm=cos(thp1_cm*3.1415927/180.0)
      call lab_cm(rmkk,pp_cm,plabpp2,p_cmpp2)
      thp2_cm=theta12(p_cmpp2(1),p_cmpp2(2),p_cmpp2(3),
     *                pp_cm(1),pp_cm(2),pp_cm(3))
      cosp2_cm=cos(thp2_cm*3.1415927/180.0)
c
      pgx=pxms
      pgy=pyms
      pgz=pzms
      pg=pms
      rmkg1=sqrt((e1+pms)**2-(px1+pgx)**2-(py1+pgy)**2
     *          -(pz1+pgz)**2)
      rmkg2=sqrt((e2+pms)**2-(px2+pgx)**2-(py2+pgy)**2
     *          -(pz2+pgz)**2)
c
      ppi0(1)=pxms
      ppi0(2)=pyms
      ppi0(3)=pzms
      ppi0(4)=sqrt(pms**2+rmpi0**2)
c
c   proton direction in assumed pi0_cm frame
c
      call lab_cm(rmpi0,ppi0,plabpp1,pcmpp1)
      pcmx1=pcmpp1(1)
      pcmy1=pcmpp1(2)
      pcmz1=pcmpp1(3)
c
      call lab_cm(rmpi0,ppi0,plabpp2,pcmpp2)
      pcmx2=pcmpp2(1)
      pcmy2=pcmpp2(2)
      pcmz2=pcmpp2(3)
c
c   missing pmscm, emscm in 'pi0_frame'
      plabjsi(1)=0.0
      plabjsi(2)=0.0
      plabjsi(3)=0.0
      plabjsi(4)=3.0969
      call lab_cm(rmpi0,ppi0,plabjsi,pcmjsi)
c
      pmscmx=pcmjsi(1)-(pcmx1+pcmx2)
      pmscmy=pcmjsi(2)-(pcmy1+pcmy2)
      pmscmz=pcmjsi(3)-(pcmz1+pcmz2)
      pmscm=sqrt(pmscmx**2+pmscmy**2+pmscmz**2)
      emscm=pcmjsi(4)-(pcmpp1(4)+pcmpp2(4))
c
      thkkcm = theta12(pcmx1,pcmy1,pcmz1,pcmx2,pcmy2,pcmz2)
      if( thkkcm.lt.0.0 ) return
c
c   direction of ... ppbar plane in pi0_cm frame
      vndcmx = pcmy1*pcmz2-pcmz1*pcmy2
      vndcmy = pcmz1*pcmx2-pcmx1*pcmz2
      vndcmz = pcmx1*pcmy2-pcmy1*pcmx2
c
c !  neutral tracks
      ige=0
      imodflg=0
      ig=0
      ig1=0
      ig2=0
      ig3=0
      ig4=0
      ngg=0
      nngg=0
c   thecut1 ( good gamma theta cut ) .................... (besior--usearg(10) )
c   thecut2 ( good gamma theta cut ) ...............................usearg(9) )
c   eggcut1 ( energy cut on good gamma )............................usearg(8) )
c   tdfcut1 ( thdf pre_cut on good gamma )..........................usearg(7) )
c   nsclcut ( number of sc hit layers)..............................usearg(6) )
c   nfsclcut ( # of first sc hit layer )............................usearg(5) )
c   nfsclcut1 ( # of first sc hit layer )...........................usearg(4) )
c   eggcut2 ( energy cut on good gamma )............................usearg(3) )
      thecut1   = float(usearg(10))/10000.
      thecut2   = float(usearg(9))/10000.
      phicut1   = 20.
      phicut2   = 20.
      eggcut1   = float(usearg(8))/1000.
      tdfcut1   = float(usearg(7))
      nsclcut   = usearg(6)
      nfsclcut  = usearg(5)
      nfsclcut1 = usearg(4)
      eggcut2   = float(usearg(3))/1000.      
      do 200 i3=nchrg+1,nchrg+nneu
        if( trksub(1,i3).ne.0 ) then
          if( itrk(trksub(1,i3)+4).eq.0 ) then
c   shower counter
            if( trksub(5,i3).ne.0 ) then
c   mod.#, energy, first layer coordination & direction cosines
c   of neutral track     
c   ! ig is index for gamma and its last value is also tot.# of gamma 
              indg=trksub(5,i3)
              imod=itrk(trksub(5,i3)+20)
c
              if( imod.ne.1 ) then
                imodflg=-10
                ige=ige+1
                if( ige.gt.20 ) return
                goto 200
              endif
c
              ig=ig+1
              idg(ig)=i3
c
              escn(ig)=trk(trksub(5,i3)+14)
              nscl(ig)=itrk(trksub(5,i3)+31)
              nfscl(ig)=itrk(trksub(5,i3)+32)
              nsth=0
              do il=1,nscl(ig)
                indg_l=indg+31+(il-1)*7
                nsth = nsth+itrk(indg_l+2)
                width(il)=float(itrk(indg_l+2))
              end do
              ntht(ig)=nsth
              wmax(ig)=vmax(width,nscl(ig))
c
              call hfill(501,escn(ig),0.,1.)
              call hfill(502,float(nscl(ig)),0.,1.)
	      call hfill(503,float(nfscl(ig)),0.,1.)
c
              scfx(ig)=trk(trksub(5,i3)+4)-rx0
              scfy(ig)=trk(trksub(5,i3)+6)-ry0
              scfz(ig)=trk(trksub(5,i3)+8)-rz0
              scr=sqrt(trk(trksub(5,i3)+4)**2+trk(trksub(5,i3)+6)**2)
              scosx(ig)=trk(trksub(5,i3)+27)
              scosy(ig)=trk(trksub(5,i3)+28)
              scosz(ig)=trk(trksub(5,i3)+29)
              rscf(ig)=sqrt(scfx(ig)**2+scfy(ig)**2+scfz(ig)**2)
              rscd(ig)=sqrt(scosx(ig)**2+scosy(ig)**2+scosz(ig)**2)
              if( rscf(ig).le.0.0.or.rscd(ig).le.0.0 ) goto 200
              rcosg=scfz(ig)/rscf(ig)
              call hfill(504,rcosg,0.,1.)
c
              phif(ig)=trk(trksub(5,i3)+12)
              phih(ig)=trk(trksub(5,i3)+35)
              phid(ig)=phi(scosx(ig),scosy(ig))
c         
              phdh(ig)=phi12(phid(ig),phih(ig))
              phdf(ig)=phi12(phid(ig),phif(ig))
              phhf(ig)=phi12(phih(ig),phif(ig))
              phmh(ig)=phi12(phih(ig),phms)
              phmf(ig)=phi12(phif(ig),phms)
              phph1(ig)=phi12(phih(ig),phip1)
              phph2(ig)=phi12(phih(ig),phip2)
c              phpf1(ig)=phi12(phif(ig),phip1)
c              phpf2(ig)=phi12(phif(ig),phip2)
              phpd1(ig)=phi12(phid(ig),phiscp1)
              phpd2(ig)=phi12(phid(ig),phiscp2)
c          angle between 'origin' & 'track' direction
              thdf(ig)=theta12(scfx(ig),scfy(ig),scfz(ig),
     *                         scosx(ig),scosy(ig),scosz(ig))
              call hfill(505,thdf(ig),0.,1.)
c          angle between missing_p (charged) & 'origin' direction
              thmf(ig)=theta12(pxms,pyms,pzms,
     *                         scfx(ig),scfy(ig),scfz(ig))
              rq2mf(ig)=4*pms**2*(sin(thmf(ig)*3.1415927/360.0))**2
c          angle between pp1 & 'origin' direction
              if( iscflgp1.ge.0.0 ) then
                thpf1(ig)=theta12(scfpx1,scfpy1,scfpz1,
     *                            scfx(ig),scfy(ig),scfz(ig))
                cospg1=cos(thpf1(ig)*3.1415927/180.0)
                phpf1(ig)=phi12(phif(ig),phip1)
                call hfill(506,thpf1(ig),0.,1.)
	        call hfill(508,thpf1(ig),escn(ig),1.)
                call hfill(511,phpf1(ig),0.,1.)
              else
                thpf1(ig)=200.0
                phpf1(ig)=200.0
              endif
c          angle between pp2 & 'origin' direction
              if( iscflgp2.ge.0.0 ) then
                thpf2(ig)=theta12(scfpx2,scfpy2,scfpz2,
     *                            scfx(ig),scfy(ig),scfz(ig))
                cospg2=cos(thpf2(ig)*3.1415927/180.0)
                phpf2(ig)=phi12(phif(ig),phip2)
                call hfill(507,thpf2(ig),0.,1.)
	        call hfill(508,thpf2(ig),escn(ig),1.)
                call hfill(512,phpf2(ig),0.,1.)
              else
                thpf2(ig)=200.0
                phpf2(ig)=200.0
              endif
c          angle between pp1 & 'track' direction
              thpd1(ig)=theta12(scospx1,scospy1,scospz1,
     *                          scosx(ig),scosy(ig),scosz(ig))
c          angle between pp2 & 'track' direction
              thpd2(ig)=theta12(scospx2,scospy2,scospz2,
     *                          scosx(ig),scosy(ig),scosz(ig))
c          angle between vn & 'origin' direction
              thvf(ig)=theta12(vndx,vndy,vndz,
     *                         scfx(ig),scfy(ig),scfz(ig))-90.0
c          pre-select good gamma 
              cospg1=cos(thpf1(ig)*3.1415927/180)
              cospg2=cos(thpf2(ig)*3.1415927/180)
c              if( cospg1.lt.thecut2.and.cospg2.lt.thecut2 )
              if(phicut1.lt.phpf1(ig).and.phicut2.lt.phpf2(ig)) 
     *          then
                ig1=ig1+1
                if( thdf(ig).ge.tdfcut1 ) goto 200
                ig2=ig2+1
                if( nscl(ig).lt.nsclcut.and.nfscl(ig).gt.nfsclcut.and.
     *              escn(ig).lt.eggcut2 ) goto 200
                ig3=ig3+1
                if( nfscl(ig).gt.nfsclcut1 ) goto 200
                ig4=ig4+1
                nngg=nngg+1
czj                call hfill(508,thpf1(ig),escn(ig),1.)
czj                call hfill(508,thpf2(ig),escn(ig),1.)
                idg_sg(nngg)=i3
                escn_sg(nngg)=escn(ig)
                nscl_sg(nngg)=nscl(ig)
                nfscl_sg(nngg)=nfscl(ig)
                scfx_sg(nngg)=scfx(ig)
                scfy_sg(nngg)=scfy(ig)
                scfz_sg(nngg)=scfz(ig)
                rscf_sg(nngg)=rscf(ig)
              endif
            endif
          endif
	endif
200   continue
      if( nngg.le.0.0 ) return
c
c   select good gamma
c
      do 300 iig=1,ig
        cospg1=cos(thpf1(iig)*3.1415927/180)
        cospg2=cos(thpf2(iig)*3.1415927/180)
c        if( cospg1.ge.thecut1.or.cospg2.ge.thecut1 )
        if(phicut1.gt.phpf1(iig).or.phicut2.gt.phpf2(iig)) 
     *    goto 300
        if( thdf(iig).ge.tdfcut1 ) goto 300
        if( nscl(iig).lt.nsclcut.and.nfscl(iig).gt.nfsclcut.and.
     *      escn(iig).lt.eggcut2 ) goto 300
        if( nfscl(iig).gt.nfsclcut1 ) goto 300
        if( escn(iig).le.eggcut1 ) goto 300
        ngg=ngg+1
        idg_g(ngg)=idg(iig)
        escn_g(ngg)=escn(iig)
        nscl_g(ngg)=nscl(iig)
        nfscl_g(ngg)=nfscl(iig)
        scfx_g(ngg)=scfx(iig)
        scfy_g(ngg)=scfy(iig)
        scfz_g(ngg)=scfz(iig)
        scosx_g(ngg)=scosx(iig)
        scosy_g(ngg)=scosy(iig)
        scosz_g(ngg)=scosz(iig)
        rscf_g(ngg)=rscf(iig)
        rscd_g(ngg)=rscd(iig)
        rcosgg=scfz_g(ngg)/rscf_g(ngg)
        thdf_g(ngg)=thdf(iig)
        thmf_g(ngg)=thmf(iig)
        thmd_g(ngg)=thmd(iig)
        thpf1_g(ngg)=thpf1(iig)
        thpd1_g(ngg)=thpd1(iig)
        thpf2_g(ngg)=thpf2(iig)
        thpd2_g(ngg)=thpd2(iig)
        thvf_g(ngg)=thvf(iig)
        phdh_g(ngg)=phdh(iig)
        phdf_g(ngg)=phdf(iig)
        phif_g(ngg)=phif(iig)
        phmh_g(ngg)=phmh(iig)
        phmf_g(ngg)=phmf(iig)
        phph1_g(ngg)=phph1(iig)
        phph2_g(ngg)=phph2(iig)
        phpf1_g(ngg)=phpf1(iig)
        phpf2_g(ngg)=phpf2(iig)
        phpd1_g(ngg)=phpd1(iig)
        phpd2_g(ngg)=phpd2(iig)
        rq2mf_g(ngg)=rq2mf(iig)
        rq2md_g(ngg)=rq2md(iig)
        plabg(1)=scfx(iig)
        plabg(2)=scfy(iig)
        plabg(3)=scfz(iig)
        plabg(4)=rscf(iig)
        call lab_cm(rmpi0,ppi0,plabg,pcmg)
        thmfcm_g(ngg)=theta12(ppi0(1),ppi0(2),ppi0(3),
     *                        pcmg(1),pcmg(2),pcmg(3))
        phcm_g=phi(pcmg(1),pcmg(2))
        phmfcm_g(ngg)=phi12(phcm_g,phms)
        thpf1cm_g(ngg)=theta12(pcmx1,pcmy1,pcmz1,
     *                         pcmg(1),pcmg(2),pcmg(3))
        thpf2cm_g(ngg)=theta12(pcmx2,pcmy2,pcmz2,
     *                         pcmg(1),pcmg(2),pcmg(3))
        thvfcm_g(ngg)=theta12(vndcmx,vndcmy,vndcmz,
     *                        pcmg(1),pcmg(2),pcmg(3))-90.0
        thvfcm1_g(ngg)=theta12(vndx,vndy,vndz,
     *                        pcmg(1),pcmg(2),pcmg(3))-90.0
300   continue
c
      if( ngg.le.0 ) return
c
c   squid for pi0
c
      chi2=2000000.0
      nnpi0=0
      rmgg=-10.0
      rmdif=-10.0
      energy=3.097
c
      if( nngg.ge.2 ) then
        do inp1=2,nngg
          do inp2=1,inp1-1
            nnpi0=nnpi0+1
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(inp2),npart,mass,pspec,rc,ivs)
      call psres2(rmpi0,3,4,nres,mres,pmem,mem,rc)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(inp2),npart,mass,pspec,rc,ivs)
      call psres2(rmpi0,3,4,nres,mres,pmem,mem,rc)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)

      chi2_p(nnpi0)=chi2
c
      thgg_p(nnpi0)=theta12(scfx_sg(inp1),scfy_sg(inp1),scfz_sg(inp1),
     *                      scfx_sg(inp2),scfy_sg(inp2),scfz_sg(inp2))
            egdif_p(nnpi0)=(escn_sg(inp1)-escn_sg(inp2))/
     *                     (escn_sg(inp1)+escn_sg(inp2))
           plab1(1)=scfx_sg(inp1)
           plab1(2)=scfy_sg(inp1)
           plab1(3)=scfz_sg(inp1)
           plab1(4)=rscf_sg(inp1)
           call lab_cm(rmpi0,ppi0,plab1,pcm1)
           plab2(1)=scfx_sg(inp2)
           plab2(2)=scfy_sg(inp2)
           plab2(3)=scfz_sg(inp2)
           plab2(4)=rscf_sg(inp2)
           call lab_cm(rmpi0,ppi0,plab2,pcm2)
c
           api0_cm(nnpi0)=theta12(pcm1(1),pcm1(2),pcm1(3),
     *                            -pcm2(1),-pcm2(2),-pcm2(3))
           plab1(1)=scfx_sg(inp2)
           plab1(2)=scfy_sg(inp2)
           plab1(3)=scfz_sg(inp2)
           plab1(4)=rscf_sg(inp2)
           call lab_cm(rmpi0,ppi0,plab1,pcm1)
           pcm2(1)=-pcm1(1)
           pcm2(2)=-pcm1(2)
           pcm2(3)=-pcm1(3)
           pcm2(4)=pcm1(4)
           call cm_lab(rmpi0,ppi0,pcm2,plab2)
c
           api0_1=theta12(scfx_sg(inp1),scfy_sg(inp1),scfz_sg(inp1),
     *                    plab2(1),plab2(2),plab2(3))
           plab1(1)=scfx_sg(inp1)
           plab1(2)=scfy_sg(inp1)
           plab1(3)=scfz_sg(inp1)
           plab1(4)=rscf_sg(inp1)
           call lab_cm(rmpi0,ppi0,plab1,pcm1)
           pcm2(1)=-pcm1(1)
           pcm2(2)=-pcm1(2)
           pcm2(3)=-pcm1(3)
           pcm2(4)=pcm1(4)
           call cm_lab(rmpi0,ppi0,pcm2,plab2)
           api0_2=theta12(scfx_sg(inp2),scfy_sg(inp2),
     *                           scfz_sg(inp2),
     *                           plab2(1),plab2(2),plab2(3))
c
           if( api0_1.le.api0_2 ) api0_p(nnpi0)=api0_1
           if( api0_2.lt.api0_1 ) api0_p(nnpi0)=api0_2
c
           pgx1=escn_sg(inp1)*scfx_sg(inp1)/rscf_sg(inp1)
           pgy1=escn_sg(inp1)*scfy_sg(inp1)/rscf_sg(inp1)
           pgz1=escn_sg(inp1)*scfz_sg(inp1)/rscf_sg(inp1)
           eg1=escn_sg(inp1)
           pgx2=escn_sg(inp2)*scfx_sg(inp2)/rscf_sg(inp2)
           pgy2=escn_sg(inp2)*scfy_sg(inp2)/rscf_sg(inp2)
           pgz2=escn_sg(inp2)*scfz_sg(inp2)/rscf_sg(inp2)
           eg2=escn_sg(inp2)
           rmgg_p(nnpi0)=sqrt((eg1+eg2)**2-(pgx1+pgx2)**2
     *                       -(pgy1+pgy2)**2-(pgz1+pgz2)**2)
c
           rmdif_p(nnpi0)=abs(rmgg_p(nnpi0)-rmpi0)
          end do
        end do
        chi2minp = vmin(chi2_p,nnpi0)
        idfp = lvmin(api0_p,nnpi0)
        thedif1=api0_p(idfp)
        rmgg=rmgg_p(idfp)
        thgg=thgg_p(idfp)
        egdif=egdif_p(idfp)
        thedif1_cm = vmin(api0_cm,nnpi0)
        rmdif=vmin(rmdif_p,nnpi0)
        idfpi0 = lvmin(rmdif_p,nnpi0)
        rmggpi0=rmgg_p(idfpi0)
      endif
c
c---squid for ggK+K-  (free combination of photon pairs)
c
      chi2=2000000.0
      nnpi01=0
      energy=3.097
c
      if( nngg.ge.2 ) then
        do inp1=2,nngg
          do inp2=1,inp1-1
            nnpi01=nnpi01+1
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(inp2),npart,mass,pspec,rc,ivs)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(inp2),npart,mass,pspec,rc,ivs)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
      chi2_p1(nnpi01)=chi2
      pg1x1 = pfit(1,3)
      pg1y1 = pfit(2,3)
      pg1z1 = pfit(3,3)
      pg1e1 = pfit(4,3)
      pg1x2 = pfit(1,4)
      pg1y2 = pfit(2,4)
      pg1z2 = pfit(3,4)
      pg1e2 = pfit(4,4)
      rmpi01(nnpi01) = sqrt((pg1e1+pg1e2)**2-
     >     (pg1x1+pg1x2)**2-(pg1y1+pg1y2)**2-(pg1z1+pg1z2)**2)
c
          end do
        end do
c
        idfp1 = lvmin(chi2_p1,nnpi01)
        chi2minp1 = chi2_p1(idfp1)
        rmpi01m = rmpi01(idfp1)
      endif
c
c---squid for ggpi+pi-  (free combination of photon pairs)
c
      chi2=2000000.0
      nnpi02=0
      energy=3.097
c
      if( nngg.ge.2 ) then
        do inp1=2,nngg
          do inp2=1,inp1-1
            nnpi02=nnpi02+1
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmpi,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmpi,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(inp2),npart,mass,pspec,rc,ivs)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmpi,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmpi,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(inp2),npart,mass,pspec,rc,ivs)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
      chi2_p2(nnpi02)=chi2
      pg2x1 = pfit(1,3)
      pg2y1 = pfit(2,3)
      pg2z1 = pfit(3,3)
      pg2e1 = pfit(4,3)
      pg2x2 = pfit(1,4)
      pg2y2 = pfit(2,4)
      pg2z2 = pfit(3,4)
      pg2e2 = pfit(4,4)
      rmpi02(nnpi02) = sqrt((pg2e1+pg2e2)**2-
     >     (pg2x1+pg2x2)**2-(pg2y1+pg2y2)**2-(pg2z1+pg2z2)**2)
c
          end do
        end do
c
        idfp2 = lvmin(chi2_p2,nnpi02)
        chi2minp2 = chi2_p2(idfp2)
        rmpi02m = rmpi02(idfp2)
      endif
c
c   squid for gkk
c
      chi2=200000.0
      do 400 ing=1,ngg
        epms_f(ing)=20.0
        rq2mg_f(ing)=20.0
        if( thmf_g(ing).ge.18.0 ) goto 400
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_g(ing),
     *                                  npart,mass,pspec,rc,ivs)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_g(ing),
     *                                   npart,mass,pspec,rc,ivs)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *               mres,pmem,mem,rc,chi2,pfit)
c
      chi2_g(ing)=chi2
c
        pf1 = sqrt(pfit(1,1)**2+pfit(2,1)**2+pfit(3,1)**2)
        pf2 = sqrt(pfit(1,2)**2+pfit(2,2)**2+pfit(3,2)**2)
        pfx1=pfit(1,1)
        pfy1=pfit(2,1)
        pfz1=pfit(3,1)
        pfx2=pfit(1,2)
        pfy2=pfit(2,2)
        pfz2=pfit(3,2)
        pfxg=pfit(1,3)
        pfyg=pfit(2,3)
        pfzg=pfit(3,3)
        vndfx = pfy1*pfz2-pfz1*pfy2
        vndfy = pfz1*pfx2-pfx1*pfz2
        vndfz = pfx1*pfy2-pfy1*pfx2
c
c  the 4-momentum of K+, K- & Gamma
c
        ppx1(ing) = pfit(1,1)
        ppy1(ing) = pfit(2,1)
        ppz1(ing) = pfit(3,1)
	ee1(ing) = pfit(4,1)
        amass1(ing) = mass(1)
        ppx2(ing) = pfit(1,2)
        ppy2(ing) = pfit(2,2)
        ppz2(ing) = pfit(3,2)
        ee2(ing) = pfit(4,2)
        amass2(ing) = mass(2)
        ppx3(ing) = pfit(1,3)
        ppy3(ing) = pfit(2,3)
        ppz3(ing) = pfit(3,3)
        ee3(ing) = pfit(4,3)
        amass3(ing) = mass(3)
c
        pfg_g(ing) = sqrt(pfit(1,3)**2+pfit(2,3)**2+pfit(3,3)**2)
        eftot = pfit(4,1)+pfit(4,2)
        efms=3.0969-eftot
        pfxms=-pfx1-pfx2
        pfyms=-pfy1-pfy2
        pfzms=-pfz1-pfz2
        phfms=phi(pfxms,pfyms)
        pfms=sqrt(pfxms*pfxms+pfyms*pfyms+pfzms*pfzms)
        cosg_f(ing)=pfzms/pfms
        if( pfms.le.0.0 ) return
        epms_f(ing)=efms-pfms
c
        phmg_f(ing)=phi12(phif_g(ing),phfms)
        thvg_f(ing)=abs(theta12(vndfx,vndfy,vndfz,
     *                scfx_g(ing),scfy_g(ing),scfz_g(ing))-90.0)
        thmg_f(ing)=theta12(pfxms,pfyms,pfzms,
     *                   scfx_g(ing),scfy_g(ing),scfz_g(ing))
        rq2mg_f(ing)=4*pfms**2*(sin(thmg_f(ing)*3.1415927/360.0))**2
c
        fmkk(ing)=sqrt(eftot**2-(pfit(1,1)+pfit(1,2))**2
     *          -(pfit(2,1)+pfit(2,2))**2-(pfit(3,1)+pfit(3,2))**2)
c
        fmgk1(ing)=sqrt((pfit(4,3)+pfit(4,1))**2
     *                  -(pfit(1,3)+pfit(1,1))**2
     *                  -(pfit(2,3)+pfit(2,1))**2
     *                  -(pfit(3,3)+pfit(3,1))**2)
        fmgk2(ing)=sqrt((pfit(4,3)+pfit(4,2))**2
     *                  -(pfit(1,3)+pfit(1,2))**2
     *                  -(pfit(2,3)+pfit(2,2))**2
     *                  -(pfit(3,3)+pfit(3,2))**2)
c
c--------  to calculate the 3 angles  --------
c
        do j=1,4
          do i=1,3
            p(j,i+80)=pfit(j,i)
          end do
        end do
        p(5,81)=mass(1)
        p(5,82)=mass(2)
        p(5,83)=mass(3)
c
        call punit$(80,3)
        call angle(80,81,82,0,83,cgammea,cresmea,ckmea,phikmea,0)
        thetv1(ing)=cgammea
        thetv2(ing)=cresmea
        thetam(ing)=ckmea  
        phim(ing)=phikmea 
c
c---------
c
        plabpp1(1)=pfx1
        plabpp1(2)=pfy1
        plabpp1(3)=pfz1
        plabpp1(4)=sqrt(rmkoan**2+pf1**2)
        plabpp2(1)=pfx2
        plabpp2(2)=pfy2
        plabpp2(3)=pfz2
        plabpp2(4)=sqrt(rmkoan**2+pf2**2)
        pp_cm(1)=-pfxms
        pp_cm(2)=-pfyms
        pp_cm(3)=-pfzms
        pp_cm(4)=eftot
        call lab_cm(fmkk(ing),pp_cm,plabpp1,p_cmpp1)
        thpf1_cm=theta12(p_cmpp1(1),p_cmpp1(2),p_cmpp1(3),
     *                   pp_cm(1),pp_cm(2),pp_cm(3))
        cospf1_cm(ing)=cos(thpf1_cm*3.1415927/180.0)
        call lab_cm(fmkk(ing),pp_cm,plabpp2,p_cmpp2)
        thpf2_cm=theta12(p_cmpp2(1),p_cmpp2(2),p_cmpp2(3),
     *                   pp_cm(1),pp_cm(2),pp_cm(3))
        cospf2_cm(ing)=cos(thpf2_cm*3.1415927/180.0)
400   continue
c
      idfg = lvmin(chi2_g,ngg)
      chi2ming = chi2_g(idfg)
c
c   squid for gpipi
c
      chi2=200000.0
      do 500 ing=1,ngg
        chi2_g(ing)=200000.0
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmpi,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmpi,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_g(ing),
     *                                npart,mass,pspec,rc,ivs)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmpi,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmpi,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_g(ing),
     *                                 npart,mass,pspec,rc,ivs)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
c
      chi2_g(ing)=chi2
c
500   continue
c
      idfpi = lvmin(chi2_g,ngg)
      chi2minpi = chi2_g(idfpi)
c
      chi2p=chi2minp
      chi2g=chi2ming
c
      idhi = 999
      idsq = 999
      encom = -999.
      do i=1,nngg
        if(escn_sg(i).gt.encom) then
          encom=escn_sg(i)
          idhi = i
        endif
        if(escn_sg(i).eq.escn_g(idfg)) then
          idsq = i
        endif
      enddo
c
c---squid for ggK+K-  (one photon with highest energy )
c
      chi2=2000000.0
      nnpi03=0
      energy=3.097
c
      if( nngg.ge.2 ) then
        do inp1=1,nngg
           if(inp1.ne.idhi) then
             nnpi03=nnpi03+1
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(idhi),npart,mass,pspec,rc,ivs)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(idhi),npart,mass,pspec,rc,ivs)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
      chi2_p3(nnpi03)=chi2
      pg3x1 = pfit(1,3)
      pg3y1 = pfit(2,3)
      pg3z1 = pfit(3,3)
      pg3e1 = pfit(4,3)
      pg3x2 = pfit(1,4)
      pg3y2 = pfit(2,4)
      pg3z2 = pfit(3,4)
      pg3e2 = pfit(4,4)
      rmpi03(nnpi03) = sqrt((pg3e1+pg3e2)**2-
     >     (pg3x1+pg3x2)**2-(pg3y1+pg3y2)**2-(pg3z1+pg3z2)**2)
c
           endif
c
        end do
c
        idfp3 = lvmin(chi2_p3,nnpi03)
        chi2minp3 = chi2_p3(idfp3)
        rmpi03m = rmpi03(idfp3)
      endif
c
c---squid for ggpi+pi-  (one photon with highest energy)
c
      chi2=2000000.0
      nnpi04=0
      energy=3.097
c
      if( nngg.ge.2 ) then
        do inp1=1,nngg
           if(inp1.ne.idhi) then
             nnpi04=nnpi04+1
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmpi,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmpi,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(idhi),npart,mass,pspec,rc,ivs)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmpi,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmpi,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(idhi),npart,mass,pspec,rc,ivs)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
      chi2_p4(nnpi04)=chi2
      pg4x1 = pfit(1,3)
      pg4y1 = pfit(2,3)
      pg4z1 = pfit(3,3)
      pg4e1 = pfit(4,3)
      pg4x2 = pfit(1,4)
      pg4y2 = pfit(2,4)
      pg4z2 = pfit(3,4)
      pg4e2 = pfit(4,4)
      rmpi04(nnpi04) = sqrt((pg4e1+pg4e2)**2-
     >     (pg4x1+pg4x2)**2-(pg4y1+pg4y2)**2-(pg4z1+pg4z2)**2)
c
           endif
c
        end do
c
        idfp4 = lvmin(chi2_p4,nnpi04)
        chi2minp4 = chi2_p4(idfp4)
        rmpi04m = rmpi04(idfp4)
      endif
c
c---squid for ggK+K-  (one photon with ID = idfg )
c
      chi2=2000000.0
      nnpi05=0
      energy=3.097
c
      if( nngg.ge.2 ) then
        do inp1=1,nngg
           if(inp1.ne.idsq) then
             nnpi05=nnpi05+1
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(idsq),npart,mass,pspec,rc,ivs)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(idsq),npart,mass,pspec,rc,ivs)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
      chi2_p5(nnpi05)=chi2
      pg5x1 = pfit(1,3)
      pg5y1 = pfit(2,3)
      pg5z1 = pfit(3,3)
      pg5e1 = pfit(4,3)
      pg5x2 = pfit(1,4)
      pg5y2 = pfit(2,4)
      pg5z2 = pfit(3,4)
      pg5e2 = pfit(4,4)
      rmpi05(nnpi05) = sqrt((pg5e1+pg5e2)**2-
     >     (pg5x1+pg5x2)**2-(pg5y1+pg5y2)**2-(pg5z1+pg5z2)**2)
c
           endif
c
        end do
c
        idfp5 = lvmin(chi2_p5,nnpi05)
        chi2minp5 = chi2_p5(idfp5)
        rmpi05m = rmpi05(idfp5)
      endif
c
c---squid for ggpi+pi-  (one photon with ID = idfg)
c
      chi2=2000000.0
      nnpi06=0
      energy=3.097
c
      if( nngg.ge.2 ) then
        do inp1=1,nngg
           if(inp1.ne.idsq) then
             nnpi06=nnpi06+1
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmpi,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmpi,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(idsq),npart,mass,pspec,rc,ivs)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmpi,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmpi,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,1,1,1,idg_sg(idsq),npart,mass,pspec,rc,ivs)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
      chi2_p6(nnpi06)=chi2
      pg6x1 = pfit(1,3)
      pg6y1 = pfit(2,3)
      pg6z1 = pfit(3,3)
      pg6e1 = pfit(4,3)
      pg6x2 = pfit(1,4)
      pg6y2 = pfit(2,4)
      pg6z2 = pfit(3,4)
      pg6e2 = pfit(4,4)
      rmpi06(nnpi06) = sqrt((pg6e1+pg6e2)**2-
     >     (pg6x1+pg6x2)**2-(pg6y1+pg6y2)**2-(pg6z1+pg6z2)**2)
c
           endif
c
        end do
c
        idfp6 = lvmin(chi2_p6,nnpi06)
        chi2minp6 = chi2_p6(idfp6)
        rmpi06m = rmpi06(idfp6)
      endif
c
      chi2pi1 = chi2minp1
      chi2pi2 = chi2minp2
      chi2pi3 = chi2minp3
      chi2pi4 = chi2minp4
      chi2pi5 = chi2minp5
      chi2pi6 = chi2minp6
c
      if( chi2ming.ge.50.and.irun.gt.0 ) return       
c
c---squid for gg_{missing}K+K-  (loose photon selection)
c
      chi2=2000000.0
      nnpi07=0
      energy=3.097
c
      do inp1=1,nngg
        nnpi07 = nnpi07+1
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,0,0,0,0,npart,mass,pspec,rc,ivs)
      call psres2(rmpi0,3,4,nres,mres,pmem,mem,rc)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,0,0,0,0,npart,mass,pspec,rc,ivs)
      call psres2(rmpi0,3,4,nres,mres,pmem,mem,rc)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
      chi2_p7(nnpi07)=chi2
c
         pk7x1 = pfit(1,1)
         pk7y1 = pfit(2,1)
         pk7z1 = pfit(3,1)
         pk7e1 = pfit(4,1)
         pk7x2 = pfit(1,2)
         pk7y2 = pfit(2,2)
         pk7z2 = pfit(3,2)
         pk7e2 = pfit(4,2)
         pg7x1 = pfit(1,3)
         pg7y1 = pfit(2,3)
         pg7z1 = pfit(3,3)
         pg7e1 = pfit(4,3)
         pg7x2 = pfit(1,4)
         pg7y2 = pfit(2,4)
         pg7z2 = pfit(3,4)
         pg7e2 = pfit(4,4)
         rmpi07(nnpi07) = sqrt((pg7e1+pg7e2)**2-
     >        (pg7x1+pg7x2)**2-(pg7y1+pg7y2)**2-(pg7z1+pg7z2)**2)
         rmkk07(nnpi07) = sqrt((pk7e1+pk7e2)**2-
     >        (pk7x1+pk7x2)**2-(pk7y1+pk7y2)**2-(pk7z1+pk7z2)**2)
         rmks107(nnpi07) = sqrt((3.097-pk7e2)**2
     >                               -pk7x2**2-pk7y2**2-pk7z2**2)
         rmks207(nnpi07) = sqrt((3.097-pk7e1)**2
     >                               -pk7x1**2-pk7y1**2-pk7z1**2)
c
      end do
c
        idfp7 = lvmin(chi2_p7,nnpi07)
        chi2minp7 = chi2_p7(idfp7)
        rmpi07m = rmpi07(idfp7)
        rmkk07m = rmkk07(idfp7)      
        rmks107m = rmks107(idfp7)      
        rmks207m = rmks207(idfp7)      
c
c---squid for gg_{missing}K+K-  (tight photon selection)
c
      chi2=2000000.0
      nnpi08=0
      energy=3.097
c
      do inp1=1,ngg
        nnpi08 = nnpi08+1
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_g(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,0,0,0,0,npart,mass,pspec,rc,ivs)
      call psres2(rmpi0,3,4,nres,mres,pmem,mem,rc)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_g(inp1),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,0,0,0,0,npart,mass,pspec,rc,ivs)
      call psres2(rmpi0,3,4,nres,mres,pmem,mem,rc)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
      chi2_p8(nnpi08)=chi2
c
         pk8x1 = pfit(1,1)
         pk8y1 = pfit(2,1)
         pk8z1 = pfit(3,1)
         pk8e1 = pfit(4,1)
         pk8x2 = pfit(1,2)
         pk8y2 = pfit(2,2)
         pk8z2 = pfit(3,2)
         pk8e2 = pfit(4,2)
         pg8x1 = pfit(1,3)
         pg8y1 = pfit(2,3)
         pg8z1 = pfit(3,3)
         pg8e1 = pfit(4,3)
         pg8x2 = pfit(1,4)
         pg8y2 = pfit(2,4)
         pg8z2 = pfit(3,4)
         pg8e2 = pfit(4,4)
         rmpi08(nnpi08) = sqrt((pg8e1+pg8e2)**2-
     >        (pg8x1+pg8x2)**2-(pg8y1+pg8y2)**2-(pg8z1+pg8z2)**2)
         rmkk08(nnpi08) = sqrt((pk8e1+pk8e2)**2-
     >        (pk8x1+pk8x2)**2-(pk8y1+pk8y2)**2-(pk8z1+pk8z2)**2)
         rmks108(nnpi08) = sqrt((3.097-pk8e2)**2
     >                               -pk8x2**2-pk8y2**2-pk8z2**2)
         rmks208(nnpi08) = sqrt((3.097-pk8e1)**2
     >                               -pk8x1**2-pk8y1**2-pk8z1**2)
c
      end do
c
        idfp8 = lvmin(chi2_p8,nnpi08)
        chi2minp8 = chi2_p8(idfp8)
        rmpi08m = rmpi08(idfp8)
        rmkk08m = rmkk08(idfp8)      
        rmks108m = rmks108(idfp8)      
        rmks208m = rmks208(idfp8)      
c
c---squid for gg_{missing}K+K-  (photon through 4-C)
c
      chi2=2000000.0
      nnpi09=0
      energy=3.097
c
      call psinit(energy,npart,nres,rc)
      if(ivs.ne.8.and.ivs.ne.103)then
      call pstrkcp(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call pstrkcp(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(idsq),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,0,0,0,0,npart,mass,pspec,rc,ivs)
      call psres2(rmpi0,3,4,nres,mres,pmem,mem,rc)
      elseif(ivs.eq.8.or.ivs.eq.103)then
      call psdotrkc(1,rmkoan,1,1,1,ipid1,npart,mass,pspec,rc,ivs)
      call psdotrkc(2,rmkoan,1,1,1,ipid2,npart,mass,pspec,rc,ivs)
      call pstrkcp(3,0.,1,1,1,idg_sg(idsq),npart,mass,pspec,rc,ivs)
      call pstrkcp(4,0.,0,0,0,0,npart,mass,pspec,rc,ivs)
      call psres2(rmpi0,3,4,nres,mres,pmem,mem,rc)
      endif  
c
      oksq=newsquid(npart,mass,pspec,nres,
     *              mres,pmem,mem,rc,chi2,pfit)
      nnpi09 = nnpi09+1
      chi2_p9(nnpi09)=chi2
c
         pk9x1 = pfit(1,1)
         pk9y1 = pfit(2,1)
         pk9z1 = pfit(3,1)
         pk9e1 = pfit(4,1)
         pk9x2 = pfit(1,2)
         pk9y2 = pfit(2,2)
         pk9z2 = pfit(3,2)
         pk9e2 = pfit(4,2)
         pg9x1 = pfit(1,3)
         pg9y1 = pfit(2,3)
         pg9z1 = pfit(3,3)
         pg9e1 = pfit(4,3)
         pg9x2 = pfit(1,4)
         pg9y2 = pfit(2,4)
         pg9z2 = pfit(3,4)
         pg9e2 = pfit(4,4)
         rmpi09(nnpi09) = sqrt((pg9e1+pg9e2)**2-
     >        (pg9x1+pg9x2)**2-(pg9y1+pg9y2)**2-(pg9z1+pg9z2)**2)
         rmkk09(nnpi09) = sqrt((pk9e1+pk9e2)**2-
     >        (pk9x1+pk9x2)**2-(pk9y1+pk9y2)**2-(pk9z1+pk9z2)**2)
         rmks109(nnpi09) = sqrt((3.097-pk9e2)**2
     >                               -pk9x2**2-pk9y2**2-pk9z2**2)
         rmks209(nnpi09) = sqrt((3.097-pk9e1)**2
     >                               -pk9x1**2-pk9y1**2-pk9z1**2)
c
        idfp9 = lvmin(chi2_p9,nnpi09)
        chi2minp9 = chi2_p9(idfp9)
        rmpi09m = rmpi09(idfp9)
        rmkk09m = rmkk09(idfp9)      
        rmks109m = rmks109(idfp9)      
        rmks209m = rmks209(idfp9)      
c
      chi2pi7 = chi2minp7
      chi2pi8 = chi2minp8
      chi2pi9 = chi2minp9
c
      rq2_100 = rq2mf_g(idfg)*100.0
      totth = 360.0-(thkk+thpf1_g(idfg)+thpf2_g(idfg))
      totthcm = 360.0-(thkkcm+thpf1cm_g(idfg)+thpf2cm_g(idfg))
      athvf=abs(thvf_g(idfg))
      athvfcm=abs(thvfcm_g(idfg))
c
czj      if( (pid1.ne.5.and.pid1.ne.51.and.pid1.ne.52).and.
czj     *    (pid2.ne.5.and.pid2.ne.51.and.pid2.ne.52) ) return
c
      xirun = float(irun)
      xirec = float(irec)
      xtottks = float(tottks)
      xnmdc = float(nmdc)
      xnneu = float(nneu)
      xpid1 = float(pid1)
      xpid2 = float(pid2)
      xrx1    = rx1
      xry1    = ry1
      xrz1    = rz1 
      xrx2    = rx2
      xry2    = ry2
      xrz2    = rz2
      xcosk1  = rcth1 
      xcosk2  = rcth2
      xpxyk1   = pxy1
      xpxyk2   = pxy2
      xpp1    = pp1
      xpp2    = pp2
      xtof1   = tof1
      xtof2   = tof2  
      xtq1 = tq1
      xtq2 = tq2
      xdeltat = rdelt
      iiscf1 = iscflgp1
      iiscf2 = iscflgp2
      xesc1     = esc1
      xesc2     = esc2
      xrmkk     = rmkk
      xrmks1 = rmkstar1
      xrmks2 = rmkstar2
      xrmkg1    = rmkg1
      xrmkg2    = rmkg2
      xumiss    = epms
      xapi0  = thedif1    
      xq2    = rq2mf_g(idfg)    
      xchi2g = chi2ming    
      xchi2pi= chi2minpi    
      xfmkk = fmkk(idfg)    
      xfmgk1 = fmgk1(idfg)    
      xfmgk2 = fmgk2(idfg)   
      xcthetv = thetv1(idfg)    
      xcthetx = thetv2(idfg)    
      xcthetm = thetam(idfg)    
      xphim = phim(idfg)    
      xescn = escn_g(idfg)    
      inscl = nscl_g(idfg)    
      infscl = nfscl_g(idfg)    
      xcosg = scfz_g(idfg)/rscf_g(idfg)    
      xthdf = thdf_g(idfg)    
      xthpf1 = thpf1_g(idfg)    
      xthpf2 = thpf2_g(idfg)
      xphpf1 = phpf1_g(idfg)    
      xphpf2 = phpf2_g(idfg)      
      inngg = nngg    
      ingg = ngg    
      xppx1 = ppx1(idfg)     
      xppy1 = ppy1(idfg)     
      xppz1 = ppz1(idfg)     
      xee1  = ee1(idfg)     
      xamass1 = amass1(idfg)    
      xppx2 = ppx2(idfg)     
      xppy2 = ppy2(idfg)     
      xppz2 = ppz2(idfg)     
      xee2  = ee2(idfg)     
      xamass2 = amass2(idfg)    
      xppx3 = ppx3(idfg)     
      xppy3 = ppy3(idfg)     
      xppz3 = ppz3(idfg)     
      xee3  = ee3(idfg)     
      xamass3 = amass3(idfg)    
      xrmht1 = rmht1
      xrmht2 = rmht2
      xchi2pi1 = chi2pi1
      xchi2pi2 = chi2pi2
      xchi2pi3 = chi2pi3
      xchi2pi4 = chi2pi4
      xchi2pi5 = chi2pi5
      xchi2pi6 = chi2pi6
      xchi2pi7 = chi2pi7 
      xchi2pi8 = chi2pi8
      xchi2pi9 = chi2pi9
      xrmpi01m = rmpi01m
      xrmpi02m = rmpi02m 
      xrmpi03m = rmpi03m 
      xrmpi04m = rmpi04m 
      xrmpi05m = rmpi05m 
      xrmpi06m = rmpi06m
      xrmpi07m = rmpi07m
      xrmpi08m = rmpi08m 
      xrmpi09m = rmpi09m
      xrmkk07m = rmkk07m
      xrmkk08m = rmkk08m 
      xrmkk09m = rmkk09m 
      xrmks107m = rmks107m
      xrmks108m = rmks108m 
      xrmks109m = rmks109m 
      xrmks207m = rmks207m
      xrmks208m = rmks208m 
      xrmks209m = rmks209m 
      xidflag1  = float(idflag1)
      xidflag2  = float(idflag2)
      xiddflag1  = float(iddflag1)
      xiddflag2  = float(iddflag2)
      XIDGDTOF1 = FLOAT(IDGDTOF1)
      XIDGDDEDX1 = FLOAT(IDGDDEDX1)
      XIDGDCOM1 = FLOAT(IDGDCOM1)
      XIDGDTOF2 = FLOAT(IDGDTOF2)
      XIDGDDEDX2 = FLOAT(IDGDDEDX2)
      XIDGDCOM2 = FLOAT(IDGDCOM2)
      Xthkk = thkk
      Xrx0 = rx0
      Xry0 = ry0 
      Xrz0 = rz0 
c
      call hfnt(2000)  
c
cc  endsl4
      return
      end
c
c**************************************************
      subroutine bespa1
c**************************************************
      return
      end
c**************************************************
      subroutine beshis
c***************************************************************c
c                                                               c
c   hbook id is defined as following:                           c
c    (1) *--- , here * represented selected evtype, i.e., for   c
c        besel*.                                                c
c    (2) -*--,  here * represented trklst subtype ( *=0 also    c
c        means from subtype_3, usually for track geometrical    c
c        properties ).                                          c
c    (3) --*- , here * means 'do *th kind of statistics '.      c
c                                                               c
c***************************************************************c
c
       include 'pawc.inc'
       call hlimit(npawc)
c
c   hbook id for besel4
c
      call hbook1(501,'energy deposited in BSC',150,0.,1.5,0.)
      call hbook1(502,'number of sc hit layers',8,-0.5,7.5,0.)
      call hbook1(503,'# of first sc hit layer',8,-0.5,7.5,0.)
      call hbook1(504,'cos(gamma) ag$',50,-1.0,1.0,0.)
      call hbook1(505,'angle (origin--track)$',60,0.0,180.,0.)
      call hbook1(506,'angle (pp1--origin)$',60,0.0,180.,0.)
      call hbook1(507,'angle (pp2--origin)$',60,0.0,180.,0.)
      call hbook2(508,'energy vs angle',180,0.0,180.,150,0.,1.5,0.)
      call hbook1(511,'phi angle (pp1--origin)$',60,0.0,180.,0.)
      call hbook1(512,'phi angle (pp2--origin)$',60,0.0,180.,0.)
      call hropen(41,'gkkn','gkknn.rz','n',1024,istat)
      call hbnt(2000,'gammakk','d')
      call hbname(2000, 'vblk1', xirun, 'irun:r' )
      call hbname(2000, 'vblk1', xirec, 'irec:r' )
      call hbname(2000, 'vblk1', xtottks, 'tottks:r' )
      call hbname(2000, 'vblk1', xnmdc, 'nmdc:r' )
      call hbname(2000, 'vblk1', xnneu, 'nneu:r' )
      call hbname(2000, 'vblk1', xrx1, 'rx1:r' )
      call hbname(2000, 'vblk1', xry1, 'ry1:r' )
      call hbname(2000, 'vblk1', xrz1, 'rz1:r' )
      call hbname(2000, 'vblk1', xrx2, 'rx2:r' )
      call hbname(2000, 'vblk1', xry2, 'ry2:r' )
      call hbname(2000, 'vblk1', xrz2, 'rz2:r' )
      call hbname(2000, 'vblk1', xcosk1, 'cosk1:r' )
      call hbname(2000, 'vblk1', xcosk2, 'cosk2:r' )
      call hbname(2000, 'vblk1', xpxyk1, 'pxyk1:r' )
      call hbname(2000, 'vblk1', xpxyk2, 'pxyk2:r' )
      call hbname(2000, 'vblk1', xpp1, 'pp1:r' )
      call hbname(2000, 'vblk1', xpp2, 'pp2:r' )
      call hbname(2000, 'vblk1', xtof1, 'tof1:r' )
      call hbname(2000, 'vblk1', xtof2, 'tof2:r' )
      call hbname(2000, 'vblk1', xtq1, 'tq1:r' )
      call hbname(2000, 'vblk1', xtq2, 'tq2:r' )
      call hbname(2000, 'vblk1', xpid1, 'pid1:r' )
      call hbname(2000, 'vblk1', xpid2, 'pid2:r' )
      call hbname(2000, 'vblk1', xdeltat, 'deltat:r' )
      call hbname(2000, 'vblk1', iiscf1, 'iscf1:i' )
      call hbname(2000, 'vblk1', iiscf2, 'iscf2:i' )
      call hbname(2000, 'vblk1', xesc1, 'esc1:r' ) 
      call hbname(2000, 'vblk1', xesc2, 'esc2:r' ) 
      call hbname(2000, 'vblk1', xrmkk, 'rmkk:r' )
      call hbname(2000, 'vblk1', xrmks1, 'rmks1:r' )
      call hbname(2000, 'vblk1', xrmks2, 'rmks2:r' )
      call hbname(2000, 'vblk1', xrmkg1, 'rmkg1:r' )
      call hbname(2000, 'vblk1', xrmkg2, 'rmkg2:r' )
      call hbname(2000, 'vblk1', xumiss, 'umiss:r' )
      call hbname(2000, 'vblk1', xapi0, 'api0:r' )
      call hbname(2000, 'vblk1', xq2, 'q2:r' )
      call hbname(2000, 'vblk1', xchi2g, 'chi2g:r' )
      call hbname(2000, 'vblk1', xchi2pi, 'chi2pi:r' )
      call hbname(2000, 'vblk1', xfmkk, 'fmkk:r' )
      call hbname(2000, 'vblk1', xfmgk1, 'fmgk1:r' ) 
      call hbname(2000, 'vblk1', xfmgk2, 'fmgk2:r' )
      call hbname(2000, 'vblk1', xcthetv, 'cthetv:r' )
      call hbname(2000, 'vblk1', xcthetx, 'cthetx:r' )
      call hbname(2000, 'vblk1', xcthetm, 'cthetm:r' )
      call hbname(2000, 'vblk1', xphim, 'phim:r' )
      call hbname(2000, 'vblk1', xescn, 'escn:r' )
      call hbname(2000, 'vblk1', inscl, 'nscl:i' )
      call hbname(2000, 'vblk1', infscl, 'nfscl:i' )                
      call hbname(2000, 'vblk1', xcosg, 'cosg:r' )
      call hbname(2000, 'vblk1', xthdf, 'thdf:r' )
      call hbname(2000, 'vblk1', xthpf1, 'thpf1:r' )
      call hbname(2000, 'vblk1', xthpf2, 'thpf2:r' )
      call hbname(2000, 'vblk1', xphpf1, 'phpf1:r' )  
      call hbname(2000, 'vblk1', xphpf2, 'phpf2:r' )
      call hbname(2000, 'vblk1', inngg, 'nngg:i' )
      call hbname(2000, 'vblk1', ingg, 'ngg:i' )
      call hbname(2000, 'vblk1', xppx1, 'ppx1:r' )
      call hbname(2000, 'vblk1', xppy1, 'ppy1:r' ) 
      call hbname(2000, 'vblk1', xppz1, 'ppz1:r' ) 
      call hbname(2000, 'vblk1', xee1, 'ee1:r' )
      call hbname(2000, 'vblk1', xamass1, 'amass1:r' )          
      call hbname(2000, 'vblk1', xppx2, 'ppx2:r' )
      call hbname(2000, 'vblk1', xppy2, 'ppy2:r' ) 
      call hbname(2000, 'vblk1', xppz2, 'ppz2:r' ) 
      call hbname(2000, 'vblk1', xee2, 'ee2:r' )
      call hbname(2000, 'vblk1', xamass2, 'amass2:r' )                
      call hbname(2000, 'vblk1', xppx3, 'ppx3:r' )
      call hbname(2000, 'vblk1', xppy3, 'ppy3:r' ) 
      call hbname(2000, 'vblk1', xppz3, 'ppz3:r' ) 
      call hbname(2000, 'vblk1', xee3, 'ee3:r' )
      call hbname(2000, 'vblk1', xamass3, 'amass3:r' )
      call hbname(2000, 'vblk1', xrmht1, 'rmht1:r' ) 
      call hbname(2000, 'vblk1', xrmht2, 'rmht2:r' ) 
      call hbname(2000, 'vblk1', xchi2pi1, 'chi2pi1:r' )
      call hbname(2000, 'vblk1', xchi2pi2, 'chi2pi2:r' )
      call hbname(2000, 'vblk1', xchi2pi3, 'chi2pi3:r' )
      call hbname(2000, 'vblk1', xchi2pi4, 'chi2pi4:r' )
      call hbname(2000, 'vblk1', xchi2pi5, 'chi2pi5:r' )
      call hbname(2000, 'vblk1', xchi2pi6, 'chi2pi6:r' )
      call hbname(2000, 'vblk1', xrmpi01m, 'rmpi01m:r' )
      call hbname(2000, 'vblk1', xrmpi02m, 'rmpi02m:r' )
      call hbname(2000, 'vblk1', xrmpi03m, 'rmpi03m:r' )
      call hbname(2000, 'vblk1', xrmpi04m, 'rmpi04m:r' )
      call hbname(2000, 'vblk1', xrmpi05m, 'rmpi05m:r' )
      call hbname(2000, 'vblk1', xrmpi06m, 'rmpi06m:r' )
      call hbname(2000, 'vblk1', xidflag1, 'idflag1:r' )
      call hbname(2000, 'vblk1', xidflag2, 'idflag2:r' )
      call hbname(2000, 'vblk1', x1time1, 'xx1time1:r' )
      call hbname(2000, 'vblk1', x1time2, 'xx1time2:r' )
      call hbname(2000, 'vblk1', x1time3, 'xx1time3:r' )
      call hbname(2000, 'vblk1', x1timee1, 'xx1timee1:r' )
      call hbname(2000, 'vblk1', x1timee2, 'xx1timee2:r' )
      call hbname(2000, 'vblk1', x1timee3, 'xx1timee3:r' )
      call hbname(2000, 'vblk1', x1timeoff1, 'xx1timeoff1:r' )
      call hbname(2000, 'vblk1', x1timeoff2, 'xx1timeoff2:r' )
      call hbname(2000, 'vblk1', x1timeoff3, 'xx1timeoff3:r' )
      call hbname(2000, 'vblk1', x1timesig1, 'xx1timesig1:r' )
      call hbname(2000, 'vblk1', x1timesig2, 'xx1timesig2:r' )
      call hbname(2000, 'vblk1', x1timesig3, 'xx1timesig3:r' )
      call hbname(2000, 'vblk1', x2time1, 'xx2time1:r' )
      call hbname(2000, 'vblk1', x2time2, 'xx2time2:r' )
      call hbname(2000, 'vblk1', x2time3, 'xx2time3:r' )
      call hbname(2000, 'vblk1', x2timee1, 'xx2timee1:r' )
      call hbname(2000, 'vblk1', x2timee2, 'xx2timee2:r' )
      call hbname(2000, 'vblk1', x2timee3, 'xx2timee3:r' )
      call hbname(2000, 'vblk1', x2timeoff1, 'xx2timeoff1:r' )
      call hbname(2000, 'vblk1', x2timeoff2, 'xx2timeoff2:r' )
      call hbname(2000, 'vblk1', x2timeoff3, 'xx2timeoff3:r' )
      call hbname(2000, 'vblk1', x2timesig1, 'xx2timesig1:r' )
      call hbname(2000, 'vblk1', x2timesig2, 'xx2timesig2:r' )
      call hbname(2000, 'vblk1', x2timesig3, 'xx2timesig3:r' )
      call hbname(2000, 'vblk1', xiddflag1, 'iddflag1:r' )
      call hbname(2000, 'vblk1', xiddflag2, 'iddflag2:r' )
      call hbname(2000, 'vblk1', x1xsp1, 'xx1xsp1:r' )
      call hbname(2000, 'vblk1', x1xsp2, 'xx1xsp2:r' )
      call hbname(2000, 'vblk1', x1xsp3, 'xx1xsp3:r' )
      call hbname(2000, 'vblk1', x1dedxoff1, 'xx1dedxoff1:r' )
      call hbname(2000, 'vblk1', x1dedxoff2, 'xx1dedxoff2:r' )
      call hbname(2000, 'vblk1', x1dedxoff3, 'xx1dedxoff3:r' )
      call hbname(2000, 'vblk1', x1dedxsig1, 'xx1dedxsig1:r' )
      call hbname(2000, 'vblk1', x1dedxsig2, 'xx1dedxsig2:r' )
      call hbname(2000, 'vblk1', x1dedxsig3, 'xx1dedxsig3:r' )
      call hbname(2000, 'vblk1', x2xsp1, 'xx2xsp1:r' )
      call hbname(2000, 'vblk1', x2xsp2, 'xx2xsp2:r' )
      call hbname(2000, 'vblk1', x2xsp3, 'xx2xsp3:r' )
      call hbname(2000, 'vblk1', x2dedxoff1, 'xx2dedxoff1:r' )
      call hbname(2000, 'vblk1', x2dedxoff2, 'xx2dedxoff2:r' )
      call hbname(2000, 'vblk1', x2dedxoff3, 'xx2dedxoff3:r' )
      call hbname(2000, 'vblk1', x2dedxsig1, 'xx2dedxsig1:r' )
      call hbname(2000, 'vblk1', x2dedxsig2, 'xx2dedxsig2:r' )
      call hbname(2000, 'vblk1', x2dedxsig3, 'xx2dedxsig3:r' )
      call hbname(2000, 'vblk1', xIDGDTOF1, 'IDGDTOF1:r' )
      call hbname(2000, 'vblk1', xIDGDDEDX1, 'IDGDDEDX1:r' )    
      call hbname(2000, 'vblk1', xIDGDCOM1, 'IDGDCOM1:r' )    
      call hbname(2000, 'vblk1', xIDGDTOF2, 'IDGDTOF2:r' )    
      call hbname(2000, 'vblk1', xIDGDDEDX2, 'IDGDDEDX2:r' )  
      call hbname(2000, 'vblk1', xIDGDCOM2, 'IDGDCOM2:r' )    
      call hbname(2000, 'vblk1', xthkk, 'thkk:r' )
      call hbname(2000, 'vblk1', xrx0, 'rx0:r' )
      call hbname(2000, 'vblk1', xry0, 'ry0:r' )
      call hbname(2000, 'vblk1', xrz0, 'rz0:r' )   
      call hbname(2000, 'vblk1', xchi2pi7, 'chi2pi7:r' )  
      call hbname(2000, 'vblk1', xchi2pi8, 'chi2pi8:r' )
      call hbname(2000, 'vblk1', xchi2pi9, 'chi2pi9:r' )  
      call hbname(2000, 'vblk1', xrmpi07m, 'rmpi07m:r' )  
      call hbname(2000, 'vblk1', xrmpi08m, 'rmpi08m:r' )  
      call hbname(2000, 'vblk1', xrmpi09m, 'rmpi09m:r' )
      call hbname(2000, 'vblk1', xrmkk07m, 'rmkk07m:r' )  
      call hbname(2000, 'vblk1', xrmkk08m, 'rmkk08m:r' )  
      call hbname(2000, 'vblk1', xrmkk09m, 'rmkk09m:r' )
      call hbname(2000, 'vblk1', xrmks107m, 'rmks107m:r' )  
      call hbname(2000, 'vblk1', xrmks108m, 'rmks108m:r' )  
      call hbname(2000, 'vblk1', xrmks109m, 'rmks109m:r' )
      call hbname(2000, 'vblk1', xrmks207m, 'rmks207m:r' )  
      call hbname(2000, 'vblk1', xrmks208m, 'rmks208m:r' )  
      call hbname(2000, 'vblk1', xrmks209m, 'rmks209m:r' )
c
      call hprnt(2000) 
c
c   hbook id for bespa1
c
      return
      end

c**************************************************
      subroutine hisout
c**************************************************
c
      call hrout(0,icycle,'t')
      call hprint(0)
      call hrend('gkkn')
c      close(ilun)
      return
      end
c************************************************************
      function theta12(x1,y1,z1,x2,y2,z2)
c************************************************************
c                                                           *
c  this is a function to compute the angel between two      *
c  vectors.                                                 *
c                                                           *
c************************************************************
      r1=sqrt(x1*x1+y1*y1+z1*z1)
      r2=sqrt(x2*x2+y2*y2+z2*z2)
      if( r1.le.0.0.or.r2.le.0.0 ) then
czj        write (6,*) '***theta12*** zero  vector'
czj        stop
      endif
      rd=(x1*x2+y1*y2+z1*z2)/(r1*r2)
      if( rd.le.-1.0 ) then
        theta12=180.0
      else if( rd.ge.1.0 ) then
        theta12=0.0
      else if( rd.lt.1.0.and.rd.gt.-1.0 ) then
        theta12=acos(rd)*180./3.1415927
      endif
c
ccendtheta12
      end
c************************************************************
      function phi(x,y)
c************************************************************
c
c   this function gives phi angle of a vector in x-y plane
c   input: x,y----cood.
c   
c************************************************************
c      if( abs(x).le.0.0.and.abs(y).le.0.0 ) then
c        write (6,*) '***phi*** zero x_y vector'
c        stop
c      endif
      if( abs(x).le.0.0.and.y.gt.0.0 ) phi=3.1415927/2.0
      if( abs(x).le.0.0.and.y.lt.0.0 ) phi=3.1415927*3.0/2.0
      if( abs(x).le.0.0 ) return           ! avoid y divided by zero
      r=y/x
      if( x.gt.0.0.and.y.ge.0.0 ) phi=atan(r)
      if( x.gt.0.0.and.y.le.0.0 ) phi=3.1415927*2+atan(r)
      if( x.lt.0.0.and.y.ge.0.0 ) phi=3.1415927+atan(r)
      if( x.lt.0.0.and.y.le.0.0 ) phi=3.1415927+atan(r)
c
cc  endphi
      end
c************************************************************
      function phi12(x,y)
c************************************************************
c                                                           *
c  this is a function to compute the phi ( projection )     *
c  angel ( in degree ) between two vectors.                 *
c                                                           *
c   input : x,y --- phi ( projection ) of each vector       *
c                                                           *
c************************************************************
      r=x-y
100   if( r.le.3.1415927.and.r.ge.-3.1415927 ) then
        phi12=r*180./3.1415927
      else if( r.gt.3.1415927 ) then
        r=r-2*3.1415927
        goto 100
      else if( r.lt.-3.1415927 ) then
        r=r+2*3.1415927
        goto 100
      endif
      phi12=abs(phi12)
c
cc  endphi12
      end
c************************************************************
      subroutine lab_cm(rm,p0,plab,pcm)
c************************************************************
c
c  this subroutine trans. 4_vector from lab to cm frame.
c
c     input: rm ----- rest mass of cm_particle
c            p0 ----- 4_vector of cm_particle in lab frame
c                     (3_p0,e0)
c            plab --- 4_vector in lab  (3_plab,elab)
c     output: pcm --- 4_vector in cm  (3_pcm,ecm)
c     call:   lorenf --- u102 in kernlib
c
c************************************************************
      real rm,p0(4),plab(4),pcm(4)
      call lorenf(rm,p0,plab,pcm)
c
cc  endlab_cm
      return
      end
c************************************************************
      subroutine cm_lab(rm,p0,pcm,plab)
c************************************************************
c
c  this subroutine trans. 4_vector from cm to lab frame.
c
c     input: rm ----- rest mass of cm_particle
c            p0 ----- 4_vector of cm_particle in lab frame
c                     (3_p0,e0)
c            pcm ---- 4_vector in cm  (3_pcm,ecm)
c     output: plab --- 4_vector in lab  (3_plab,elab)
c     call:   lorenb --- u102 in kernlib
c
c************************************************************
      real rm,p0(4),pcm(4),plab(4)
      call lorenb(rm,p0,pcm,plab)
c
cc  endcm_lab
      return
      end

