source: PSPA/parmelaPSPA/trunk/out4.f @ 315

      subroutine out4(ne,nbuffer,outcor,nsize)
c       print phase-in, phase-out, wout
c---------------------------------------------------------------------
      save
c
      include 'param_sz.h'
      include 'constcom.h'
      include 'coordcom.h'
      include 'ncordscom.h'
      include 'outcom.h'
      include 'syscom.h'
      include 'ucom.h'
c
      common/com1/scale(10),ws,ps,zs,bgs,wts,ntape
      common/outbuf/tcor(8,imaa*imb)
      real x(imaa)
      real pin(3),pout(3),wout(3)
      integer indexx(imaa)
      dimension outcor(8,nsize)
      equivalence (tcor(1,imaa+1),x(1))
     *           ,(tcor(1      ,imaa+imaa/2),indexx(1))
c--------------------------------------------------------------------------
c*
      if(ne.eq.0)return
      ntape=2
      np=5
      if(optcon(2).eq.2.)np=6
      do 5 i=1,nbuffer
      x(i)=outcor(np,i)
      indexx(i)=i
  5   continue
      call sort(nbuffer,x,indexx)
      x0=w0/erest
      b0=sqrt(x0*(x0+2.))/(1.+x0)
      con=360./(b0*wavel)
      ps=pr(ne)
      pso=amod(ps,360.)
      ws=wr(ne)
      write(ntape,10)nbuffer,ne,pso,ws
  10  format(i5,' particles remaining after element',i3,' ps=',f7.1,
     * ' ws=',f6.2/ 3(2x,'    pin   pout   wout'))
      do 20 np=1,nbuffer,3
      j=0
      k=np
      do 18 i=1,3
      if(k.gt.nbuffer)go to 19
      kk=indexx(k)
c          get index of particle
      ind=indx(outcor(7,kk))
      pin(i)=con*(z0-cor(5,ind))
      pout(i)=outcor(5,kk)-ps
      wout(i)=outcor(6,kk)
      j=i
      k=k+1
   18 continue
   19 continue
      if(j.gt.0)write(ntape,21)(pin(i),pout(i),wout(i),i=1,j)
   21 format(3(2x,2f7.1,f7.2))
   20 continue
      return
      end
c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*