Context Navigation

flds.f @ 465

Last change on this file since 465 was 12, checked in by lemeur, 12 years ago
parmela pspa initial
File size: 1.6 KB

Line
1	subroutine flds(r,z,er,ez)
2	c------------------------------------------------------------------------
3	c
4	include 'fldcom.h'
5	include 'ucom.h'
6	c
7	r1=rp
8	z1=zp
9	c-----------------------------------------------------------------------
10	c*
11	c evaluate fields at r1,z1 due to ring of charge at r,z.
12	call fldring (r1,z1,r,z,er1,ez1)
13	if (rwall.le.0.) go to 10
14	c---calculate field due to image charge on wall
15	if (r.gt.0.9*rwall) go to 5
16	call scwall (r,z,erw,ezw)
17	er1=er1-erw
18	ez1=ez1-ezw
19	if (r1.lt.rwall) go to 10
20	er1=-erw
21	ez1=0.
22	go to 10
23	c---simulate wall by one image ring
24	5 continue
25	rim=2.*rwall-r
26	call fldring (r1,z1,rim,z,erw,ezw)
27	er1=er1-erw
28	ez1=ez1-ezw
29	10 continue
30	if (nip.eq.0) go to 50
31	erw2=0.
32	ezw2=0.
33	erw3=0.
34	ezw3=0.
35	er2=0.
36	ez2=0.
37	er3=0.
38	ez3=0.
39	do 40 i=1,nip
40	xi=i
41	if (rwall.le.0.) go to 25
42	if (r.le.0.9*rwall) go to 20
43	call fldring (r1,z1,rim,z+xi*pl,erw2,ezw2)
44	call fldring (r1,z1,rim,z-xi*pl,erw3,ezw3)
45	go to 25
46	20 continue
47	call scwall (r,z+xi*pl,erw2,ezw2)
48	call scwall (r,z-xi*pl,erw3,ezw3)
49	if (r1.eq.rwall) go to 30
50	25 continue
51	call fldring (r1,z1,r,z+xi*pl,er2,ez2)
52	call fldring (r1,z1,r,z-xi*pl,er3,ez3)
53	30 continue
54	er1=er1+er2+er3-erw2-erw3
55	ez1=ez1+ez2+ez3-ezw2-ezw3
56	40 continue
57	50 continue
58	er=er1
59	ez=ez1
60	return
61	end
62	c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*

Note: See TracBrowser for help on using the repository browser.