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

Last change on this file since 315 was 12, checked in by lemeur, 12 years ago

parmela pspa initial

File size: 5.1 KB
Line 
1      subroutine design
2c---design a graded-beta linac section.  15 parameters are in vv.
3c----------------------------------------------------------------------
4c
5      include 'param_sz.h'
6      include 'cfldscom.h'
7      include 'constcom.h'
8      include 'misccom.h'
9      include 'syscom.h'
10      include 'ucom.h'
11c
12      dimension ffc(14)
13c--------------------------------------------------------------------------
14c*
15      if(nn.lt.15)go to 100
16c---set convergence criterion to .01 degree
17      eps=.001*radian
18c---get parameters from vv
19      win=vv(1)
20      if(win.le.0.)win=w0
21      gin=win/erest
22      bin=sqrt(gin*(2.+gin))/(1.+gin)
23      phin=vv(2)*radian
24      e0=vv(3)
25      afld=vv(4)
26      bfld=vv(5)
27      dphi=vv(6)*radian
28      nphi=vv(7)
29      nmax=vv(8)
30      zmax=vv(9)
31      wmax=vv(10)
32      aper=vv(11)
33      nout=vv(12)
34      phi0=vv(13)
35      nc1=vv(14)
36      dwtm=vv(15)
37      if(nn.gt.15)ltype=vv(16)
38      az=0.
39      bz=0.
40      cz=0.
41      if(nn.gt.16)az=vv(17)
42      if(nn.gt.17)bz=vv(18)
43      if(nn.gt.18)cz=vv(19)
44      attf=0.
45      bttf=0.
46      cttf=0.
47      if(nn.gt.19)attf=vv(20)
48      if(nn.gt.20)bttf=vv(21)
49      if(nn.gt.21)cttf=vv(22)
50      ptotl=0.
51      tlen=0.
52      if (nc1.gt.0) write(nnout,2)
53    2 format(' graded-beta linac section'/
54     1 ' cell  length     win    wout    phis      e0       t   phase',
55     2 '    ztsq     pcu')
56      if (nc1.le.0) write(nnout,3)
57    3 format(' graded-beta linac section'/
58     1 '  nel  length     win    wout    phis     e0t   phase',
59     2 '    ztsq     pcu')
60      if(nphi.le.0)dphi=0.
61      nc=nc1
62      zl=0.
63      dw=0.
64    5 if(nel.ge.100)go to 120
65c---first iteration sequence single cell tank
66      pout=phin+dphi+pi
67      gw=(win+.5*dw)/erest
68      bw=sqrt(gw*(2.+gw))/(1.+gw)*(1.+dphi/pi)
69      cl=.5*bw*wavel
70c---calculate phase shift to center of cell
71   10 ph=phin+.5*pi*bw/bin
72c---get transit time factor
73      if(nn.le.18)go to 11
74      t=attf+bw*(bttf+bw*cttf)
75      go to 12
76   11 if(ltype.eq.2)call sccfc(bw,ffc)
77      if(ltype.eq.7)call dawfc(bw,ffc)
78      if(ltype.ne.2.and.ltype.ne.7)call genfc(bw,ffc)
79      t=.5*ffc(1)
80   12 if(nc.gt.nc1)e0=(afld+bfld*cll/cl)*elast
81      dw=.01*e0*t*sin(ph)*cl
82      w=win+dw
83      g=w/erest
84      b=sqrt(g*(2.+g))/(1.+g)
85      ph=ph+.5*pi*bw/b
86      dp=ph-pout
87      if(abs(dp).lt.eps)go to 15
88      cl=cl*(1.-dp/(pout-phin))
89      bw=2.*cl/wavel
90      go to 10
91   15 if (nc1.le.0)go to 80
92c---continue on using field structure for cell
93      dp=pi/72.
94   20 b=bin
95      w=win
96      ph=phin
97      dz=cl/36.
98      call cellfld(cl,nc)
99      if(nc.gt.nc1)e0=(afld+bfld*cll/cl)*elast
100      zc=-.5*(cl+dz)
101      do 30 i=1,36
102      ph=ph+dp*bw/b
103      zc=zc+dz
104      call cfield(0.,zc,nc,ez,er,bt)
105      w=w+.01*e0*ez*sin(ph)*dz
106      g=w/erest
107      b=sqrt(g*(2.+g))/(1.+g)
108   30 ph=ph+dp*bw/b
109c---check for convergence
110      ep=ph-pout
111      if(abs(ep).le.eps)go to 40
112      cl=cl/(1.+ep/pi)
113      bw=2.*cl/wavel
114      go to 20
115c---convergence reached.  store parameters
116   40 phase=phi0+180.*(nc-nc1)
117      phase=amod(phase,360.)
118      phis=(ph-pi)/radian
119      t=.5*fc(1,nc)
120      ztsq=az+bw*(bz+cz*bw)
121      pcu=0.
122      if(ztsq.gt.0.)pcu=.01*(e0*t)**2*cl/ztsq
123      ptotl=ptotl+pcu
124      tlen=tlen+cl
125      write(nnout,50) nc,cl,win,w,phis,e0,t,phase,ztsq,pcu
126   50 format(i5,3f8.3,f8.2,2f8.3,f8.1,2f8.3)
127      nel=nel+1
128      ntype(nel)=7
129      el(4,nel)=phase
130      el(5,nel)=.01*e0
131      el(6,nel)=nc
132      el(7,nel)=dwtm
133      phi=phase*radian
134      el(9,nel)=sin(phi)
135      el(10,nel)=cos(phi)
136   60 el(1,nel)=cl
137      el(2,nel)=aper
138      el(3,nel)=0.
139      if(nnout.le.0)go to 70
140      if(mod(nc-nc1+1,nout).eq.0)el(3,nel)=1.
141   70 elast=e0
142      cll=cl
143      zloc(nel)=cl
144      if(nel.gt.1)zloc(nel)=zloc(nel)+zloc(nel-1)
145      nc=nc+1
146      nct=nc-nc1
147      if(nct.ge.nphi)dphi=0.
148      zl=zl+cl
149      dw=w-win
150      win=w
151      bin=b
152      phin=ph-pi
153      if(nct.ge.nmax)go to 95
154      if(zl.ge.zmax)go to 95
155      if(w.ge.wmax)go to 95
156      go to 5
157c---store tank parameters
158   80 nel=nel+1
159      ntype(nel)=8
160      el(4,nel)=.01*e0*t
161      el(5,nel)=1.
162      el(6,nel)=1.
163      phase=phi0+180.*(nc-nc1)
164      phase=amod(phase,360.)
165      phis=(ph-pi)/radian
166      e0t=e0*t
167      ztsq=az+bw*(bz+cz*bw)
168      pcu=0.
169      if(ztsq.gt.0.)pcu=.01*(e0*t)**2*cl/ztsq
170      ptotl=ptotl+pcu
171      tlen=tlen+cl
172      write(nnout,90) nel,cl,win,w,phis,e0t,phase,ztsq,pcu
173   90 format(i5,3f8.3,f8.2,f8.3,f8.1,2f8.3)
174      el(7,nel)=phase
175      el(8,nel)=cl
176      el(9,nel)=bw
177      el(10,nel)=((wavel/(2.*cl))**2 - 1.)*(twopi/wavel)**2
178      go to 60
179   95 if(ptotl.gt.0.)write(nnout,96) ptotl
180   96 format (' total power =',f8.3,' mw')
181      write(nnout,97)tlen
182   97 format (' total length of this section is ',f8.2,' cm')
183      return
184  100 write(ndiag,110) nn
185  110 format(' wrong number of parameters on design card.  nn= ',i3)
186      call appendparm
187      stop ' Abnormal stop design a '
188  120 write(ndiag,130)
189  130 format('  too many elements being generated in design')
190      call appendparm
191      stop ' Abnormal stop design b '
192      end
193c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*
Note: See TracBrowser for help on using the repository browser.