1 | subroutine out4(ne,nbuffer,outcor,nsize) |
---|
2 | c print phase-in, phase-out, wout |
---|
3 | c--------------------------------------------------------------------- |
---|
4 | save |
---|
5 | c |
---|
6 | include 'param_sz.h' |
---|
7 | include 'constcom.h' |
---|
8 | include 'coordcom.h' |
---|
9 | include 'ncordscom.h' |
---|
10 | include 'outcom.h' |
---|
11 | include 'syscom.h' |
---|
12 | include 'ucom.h' |
---|
13 | c |
---|
14 | common/com1/scale(10),ws,ps,zs,bgs,wts,ntape |
---|
15 | common/outbuf/tcor(8,imaa*imb) |
---|
16 | real x(imaa) |
---|
17 | real pin(3),pout(3),wout(3) |
---|
18 | integer indexx(imaa) |
---|
19 | dimension outcor(8,nsize) |
---|
20 | equivalence (tcor(1,imaa+1),x(1)) |
---|
21 | * ,(tcor(1 ,imaa+imaa/2),indexx(1)) |
---|
22 | c-------------------------------------------------------------------------- |
---|
23 | c* |
---|
24 | if(ne.eq.0)return |
---|
25 | ntape=2 |
---|
26 | np=5 |
---|
27 | if(optcon(2).eq.2.)np=6 |
---|
28 | do 5 i=1,nbuffer |
---|
29 | x(i)=outcor(np,i) |
---|
30 | indexx(i)=i |
---|
31 | 5 continue |
---|
32 | call sort(nbuffer,x,indexx) |
---|
33 | x0=w0/erest |
---|
34 | b0=sqrt(x0*(x0+2.))/(1.+x0) |
---|
35 | con=360./(b0*wavel) |
---|
36 | ps=pr(ne) |
---|
37 | pso=amod(ps,360.) |
---|
38 | ws=wr(ne) |
---|
39 | write(ntape,10)nbuffer,ne,pso,ws |
---|
40 | 10 format(i5,' particles remaining after element',i3,' ps=',f7.1, |
---|
41 | * ' ws=',f6.2/ 3(2x,' pin pout wout')) |
---|
42 | do 20 np=1,nbuffer,3 |
---|
43 | j=0 |
---|
44 | k=np |
---|
45 | do 18 i=1,3 |
---|
46 | if(k.gt.nbuffer)go to 19 |
---|
47 | kk=indexx(k) |
---|
48 | c get index of particle |
---|
49 | ind=indx(outcor(7,kk)) |
---|
50 | pin(i)=con*(z0-cor(5,ind)) |
---|
51 | pout(i)=outcor(5,kk)-ps |
---|
52 | wout(i)=outcor(6,kk) |
---|
53 | j=i |
---|
54 | k=k+1 |
---|
55 | 18 continue |
---|
56 | 19 continue |
---|
57 | if(j.gt.0)write(ntape,21)(pin(i),pout(i),wout(i),i=1,j) |
---|
58 | 21 format(3(2x,2f7.1,f7.2)) |
---|
59 | 20 continue |
---|
60 | return |
---|
61 | end |
---|
62 | c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
---|