subroutine trwfield c--parmela subroutine for the definition of c--background field from a series of traveling waves c---------------------------------------------------------------------- save c include 'param_sz.h' include 'constcom.h' include 'coordcom.h' include 'misccom.h' include 'pcordcom.h' include 'syscom.h' include 'tstepcom.h' include 'wavescom.h' include 'ucom.h' c real ez(16,nbtrw),cf(11,nbtrw) integer ngap c-------------------------------------------------------------------------- c* c----Ez data data (ez(i,1),i=1,16)/1.881,1.852,1.747,1.516,1.085,0.461,-.146, * -.548,-.762,-.869,-.921,-.943,-.945,-.929,-.901,-.884/ c each cavity has gradient, beta, length, freq., c phase and, in the middle, a gap. This code creates the expansion c for the E and B fields using the field in a traveling wave c accelerator described in 'LINEAR ACCELERATORS' edited by c Lopostolle and Septier pages 44 to 95. c---the data for the traveling wave accelerators is on the trwave cards c---in the following order. c---trwave L, APER, IOUT, PHI, WE, NC, DWTMAX, FREQ, GAP, NMIN, NMAX, C---PSHIFT, NW, NPRINT, Z1, Z2, R1, R2, DPHI, EZ(0-15) C---the first 9 paramaters must be on all trwave cards. nc is the traveling c---wave accelerator tank number. nc must be a number from one to seven c---each trwave card must have then same nc in a tank. each tank must have c---a unique number. NW is the total number of trwave cards in a tank. each c---trwave card contains the data for one cell of the traveling wave c---accelerator. The first trwave card must have the first 13 parameters at c---least. c---if nprint is nonzero then Z1 through R2 must be defined. if(nn.lt.9)then write(ndiag,*)' not enough parameters on this trwave card' return endif nc=vv(6) if(nelw(nc).eq.0)then nnw=1 else nnw=nnw+1 endif if(nnw.gt.1)then do 201 i=1,16 ez(i,nnw)=ez(i,nnw-1) 201 continue endif if(nelw(nc).eq.0.and.nn.lt.13)then write(ndiag,*)' not enough parameters on this trwave card' return endif if(nn.ge.20)then if(nn.lt.35)then write(ndiag,*) *' Not enough fields specified on this card. They are ignored.' else do 200 i=1,16 ez(i,nnw)=vv(19+i) 200 continue endif endif if(nn.ge.13.and.nelw(nc).eq.0)then nelw(nc)=nel nw(nc)=vv(13)+nel-1 pshif=vv(12) nmax=vv(11) nmin=vv(10) if(nn.ge.14.and.vv(14).ne.0)then if(nn.lt.18)then write(ndiag,*)' not enough parameters on this trwave card' return endif nprint=vv(14) z1=vv(15) z2=vv(16) r1=vv(17) r2=vv(18) endif if(nn.ge.19)dphi=vv(19) endif if(nel.lt.nw(nc))return do 10 i=1,nw(nc)-nelw(nc)+1 ii=i+nelw(nc)-1 el(4,ii)=el(4,ii)*pi/180. wavli=clight/el(8,ii) cay=twopi/wavli c --calculate coefficients of expansion do 9 n=nmin,nmax nm=n-nmin+1 phasfn=1.+2.*n/pshif wbeta=el(1,ii)*2*el(8,ii)/(clight*pshif) cliu if(ii.eq.nelw(nc))wbeta=wbeta*2. if(ii.eq.nelw(nc) .or. ii.eq.nw(nc))wbeta=wbeta*2. wk3(nm,i,nc)=phasfn*cay/wbeta cliu if(abs(wk3(nm,i,nc)).lt.abs(cay)) cliu wk1(nm,i,nc)=sqrt(cay**2-wk3(nm,i,nc)**2) wk1(nm,i,nc)=cay**2-wk3(nm,i,nc)**2 c---will use fields from superfish to determin wa's. c--- start of superfish coefficents determination c---integrate Ez squared. cliu if(ii.ne.nelw(nc))then if(ii.ne.nelw(nc).and.ii.ne.nw(nc))then sum=.5*(ez(1,i)+ez(16,i)*cos(wk3(nm,i,nc)*el(1,ii)/pshif)) else sum=.5*(ez(1,i)+ez(16,i)*cos(wk3(nm,i,nc)*el(1,ii)* * 2./pshif)) endif h=el(1,ii)/pshif/15. c---the first cell starts at the center of the cell. a cell card c---provids the fields for the first half. cliu if(ii.eq.nelw(nc))h=2*h if(ii.eq.nelw(nc) .or. ii.eq.nw(nc))h=2*h zz=0. do 1 j=2,15 zz=zz+h sum=sum+cos(wk3(nm,i,nc)*zz)*ez(j,i) 1 continue wa(nm,i,nc)=sum*h 9 continue c---normalize the wa's sum=0. do 2 n=nmin,nmax nm=n-nmin+1 sum=sum+wa(nm,i,nc)**2 2 continue do 3 n=nmin,nmax nm=n-nmin+1 wa(nm,i,nc)=wa(nm,i,nc)/sqrt(sum) 3 continue c--- end of determination of coefficents from superfish fields. 10 continue C--------------------------- nprint ----------------------------------- if(nprint.gt.0)then open(unit=ntrw,file='trwdata',recl=132,access='sequential', * status='unknown',form='formatted') write(ntrw,*)' expansion coefficients...' do 80 i=1,nw(nc)-nelw(nc)+1 write(ntrw,77)i 77 format(' wave No.',i4,/, *' n An K1n K3n') do 79 n=nmin,nmax nm=n-nmin+1 write(ntrw,78)n,wa(nm,i,nc),wk1(nm,i,nc),wk3(nm,i,nc) 78 format(i4,3e13.3) 79 continue 80 continue endif c--- phases should now be made to account for phase shifts in c previous cavities ( integral of k(z)dz ) if(nw(nc)-nelw(nc).gt.1)then do 110 i=2,nw(nc)-nelw(nc)+1 do 100 ii=1,i-1 iii=ii+nelw(nc)-1 do 90 n=nmin,nmax nm=n-nmin+1 if(iii.ne.nelw(nc))then wpoff(nm,i,nc)=wpoff(nm,i,nc)-wk3(nm,ii,nc)*el(1,iii) else wpoff(nm,i,nc)=wpoff(nm,i,nc)-wk3(nm,ii,nc)*el(1,iii)*2. endif 90 continue 100 continue 110 continue endif if(nprint.ne.0)then dzprint=(z2-z1)/iabs(nprint) if(dphi.ne.0.)then jend=720/dphi+.999999 else jend=1 endif wt=-dphi do 20 j=1,jend wt=wt+dphi write(ntrw,7)nw(nc)-nelw(nc),nprint,r1,r2,wt do 20 i=0,iabs(nprint) zz=z1+i*dzprint call trwave(zz,r1,wez1,wer1,wbphi1,iz,wt) call trwave(zz,r2,wez2,wer2,wbphi2,iz,wt) if(iz.eq.0)then wez1=0. wer1=0. wbphi1=0. wbphi2=0. wer2=0. wez2=0. endif izz=iz+nelw(nc)-1 wbeta=el(1,izz)*2*el(8,izz)/(clight*pshif) if(izz.eq.nelw(nc) .or. izz.eq.nw(nc))wbeta=wbeta*2. write(ntrw,30)zz,wez1,wer1,wbphi1,wez2,wer2,wbphi2,float(iz) 20 continue endif 7 format(/,' nwaves=',i5,', nprint=',i5, + /,' printed at r1=',f10.3,' and r2=',f10.3,' wt=',f10.3, + /,' z Ez(r1,z) Er(r1,z) Bphi(r1,z)' + ,' Ez(r2,z) Er(r2,z) Bphi(r2,z) Er-v*Bphi') 30 format(f10.3,7f10.3) return end c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*