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++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*