Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

Si_def_element.f90 @ 430

Last change on this file since 430 was 430, checked in by touze, 11 years ago
import madx-5.01.00
File size: 118.9 KB

Line
1	!The Polymorphic Tracking Code
2	!Copyright (C) Etienne Forest and CERN
3
4
5	MODULE S_DEF_ELEMENT
6	USE S_DEF_KIND
7	! USE USER_kind1
8	! USE USER_kind2
9	USE sagan_WIGGLER
10
11	IMPLICIT NONE
12	public
13	logical(lp),PARAMETER::BERZ=.TRUE.,ETIENNE=.NOT.BERZ
14	logical(lp) :: USE_TPSAFIT=.TRUE. ! USE GLOBAL ARRAY INSTEAD OF PERSONAL ARRAY
15	logical(lp), target :: set_tpsafit=.false.
16	logical(lp), target :: set_ELEMENT=.false.
17	real(dp) , target :: scale_tpsafit=1.0_dp
18	real(dp), target :: tpsafit(lnv) ! used for fitting with tpsa in conjunction with pol_block
19	PRIVATE copy_el_elp,copy_elp_el,copy_el_el
20	PRIVATE cop_el_elp,cop_elp_el,cop_el_el
21	private ZERO_EL,ZERO_ELP
22	! PRIVATE MAGPSTATE,MAGSTATE
23	PRIVATE SETFAMILYR,SETFAMILYP
24	PRIVATE ADDR_ANBN,ADDP_ANBN,bL_0,EL_BL,ELp_BL,COPY_BL,UNARYP_BL
25	PRIVATE ELp_POL,bLPOL_0
26	PRIVATE work_0,work_r,ELp_WORK,EL_WORK,WORK_EL,WORK_ELP,BL_EL,BL_ELP,unaryw_w
27	PRIVATE ZERO_ANBN,ZERO_ANBN_R,ZERO_ANBN_P
28	private null_EL,null_ELp
29	logical(lp), PRIVATE :: VERBOSE = .FALSE.
30	logical(lp), PRIVATE :: GEN = .TRUE.
31	logical(lp),TARGET :: ALWAYS_EXACTMIS=.TRUE.
32	logical(lp),TARGET :: FEED_P0C=.FALSE.
33	integer, TARGET :: np_pol=0
34	! logical(lp) :: isomorphism_MIS=.TRUE. !Not needed anymore always should be true
35	private put_aperture_el,put_aperture_elp
36	integer :: mfpolbloc=0
37	logical(lp),target :: recirculator_cheat=my_false
38	PRIVATE TRACKR,TRACKP
39	logical(lp), target :: restore_mag=my_true,restore_magp=my_true
40	! Old home for element and elementp, now in sh_def_kind
41
42
43
44
45
46
47
48	INTERFACE EQUAL
49	MODULE PROCEDURE copy_el_elp ! need upgrade
50	MODULE PROCEDURE copy_elp_el ! need upgrade
51	MODULE PROCEDURE copy_el_el ! need upgrade
52	end INTERFACE
53
54	INTERFACE COPY
55	MODULE PROCEDURE cop_el_elp ! need upgrade
56	MODULE PROCEDURE cop_elp_el ! need upgrade
57	MODULE PROCEDURE cop_el_el ! need upgrade
58	MODULE PROCEDURE COPY_BL
59	end INTERFACE
60
61	INTERFACE ADD
62	MODULE PROCEDURE ADDR_ANBN
63	MODULE PROCEDURE ADDP_ANBN
64	end INTERFACE
65
66	INTERFACE ZERO_ANBN
67	MODULE PROCEDURE ZERO_ANBN_R
68	MODULE PROCEDURE ZERO_ANBN_P
69	end INTERFACE
70
71
72	INTERFACE OPERATOR (+)
73	MODULE PROCEDURE unaryP_BL
74	END INTERFACE
75
76	INTERFACE OPERATOR (+)
77	MODULE PROCEDURE unaryw_w
78	END INTERFACE
79
80
81	INTERFACE print
82	MODULE PROCEDURE print_work
83	end INTERFACE
84
85	INTERFACE SETFAMILY
86	MODULE PROCEDURE SETFAMILYR ! need upgrade
87	MODULE PROCEDURE SETFAMILYP ! need upgrade
88	end INTERFACE
89
90	INTERFACE null_ELEment
91	MODULE PROCEDURE null_EL ! need upgrade
92	MODULE PROCEDURE null_ELp ! need upgrade
93	end INTERFACE
94
95	INTERFACE put_aperture
96	MODULE PROCEDURE put_aperture_el ! need upgrade
97	MODULE PROCEDURE put_aperture_elp ! need upgrade
98	end INTERFACE
99
100
101	INTERFACE ASSIGNMENT (=)
102	MODULE PROCEDURE ZERO_EL ! NEED UPGRADE
103	MODULE PROCEDURE ZERO_ELP ! NEED UPGRADE
104	! MODULE PROCEDURE MAGSTATE ! need upgrade IF STATES EXPANDED
105	! MODULE PROCEDURE MAGPSTATE ! need upgrade IF STATES EXPANDED
106	! Multipole block setting
107	MODULE PROCEDURE BL_0
108	MODULE PROCEDURE EL_BL
109	MODULE PROCEDURE ELp_BL
110	MODULE PROCEDURE BL_EL
111	MODULE PROCEDURE BL_ELP
112	! polymorphism
113	MODULE PROCEDURE bLPOL_0
114	MODULE PROCEDURE ELp_POL
115	! energy/mass retrieving
116	MODULE PROCEDURE work_0
117	MODULE PROCEDURE work_r
118	MODULE PROCEDURE ELp_WORK
119	MODULE PROCEDURE EL_WORK
120	MODULE PROCEDURE WORK_EL
121	MODULE PROCEDURE WORK_ELP
122	END INTERFACE
123
124
125	INTERFACE TRACK
126	! INTERFACE TRACK
127	MODULE PROCEDURE TRACKR
128	MODULE PROCEDURE TRACKP
129	! END INTERFACE
130	! END old Sj_elements
131	END INTERFACE
132
133
134
135
136
137	CONTAINS
138
139
140	SUBROUTINE TRACKR(EL,X,K,MID)
141	IMPLICIT NONE
142	real(dp),INTENT(INOUT):: X(6)
143	TYPE(ELEMENT),INTENT(INOUT):: EL
144	TYPE(WORM),OPTIONAL, INTENT(INOUT):: MID
145	TYPE(INTERNAL_STATE) K
146
147	if(associated(el%p%aperture)) call CHECK_APERTURE(EL%p%aperture,X)
148	! if(other_program) then
149	! call track_R(x)
150	! return
151	! endif
152	SELECT CASE(EL%KIND)
153	CASE(KIND0)
154	IF(PRESENT(MID)) CALL XMID(MID,X,0)
155	IF(PRESENT(MID)) CALL XMID(MID,X,1) ! ADDED FOR NST=1 IN MARKER FOR THIN_LAYOUT SURVEY
156	case(KIND1)
157	CALL TRACK(EL%D0,X,K,MID)
158	case(KIND2)
159	CALL TRACK(EL%K2,X,k,MID)
160	case(KIND3)
161	CALL TRACK(EL%K3,X,k,MID)
162	case(KIND4)
163	CALL TRACK(EL%C4,X,k,MID)
164	case(KIND5)
165	CALL TRACK(EL%S5,X,k,MID)
166	case(KIND6)
167	CALL TRACK(EL%T6,X,k,MID)
168	case(KIND7)
169	CALL TRACK(EL%T7,X,k,MID)
170	case(KIND8)
171	CALL TRACK(EL%S8,X,k,MID)
172	case(KIND9)
173	CALL TRACK(EL%S9,X,k,MID)
174	case(KIND10)
175	CALL TRACK(EL%TP10,X,k,MID)
176	CASE(KIND11:KIND14)
177	call TRACK(EL%MON14,X,k,MID)
178	CASE(KIND15)
179	call TRACK(EL%SEP15,X,k,MID)
180	CASE(KIND16,KIND20)
181	call TRACK(EL%K16,X,k,MID)
182	CASE(KIND18)
183	call TRACK(EL%RCOL18,X,k,MID)
184	CASE(KIND19)
185	call TRACK(EL%ECOL19,X,k,MID)
186	CASE(KIND21)
187	call TRACK(EL%CAV21,X,k,MID)
188	CASE(KIND22)
189	call TRACK(EL%HE22,X,k,MID)
190	case(KINDWIGGLER)
191	call TRACK(EL%WI,X,k,MID)
192	case(KINDPA)
193	call TRACK(EL%PA,X,k,MID)
194	case default
195	w_p=0
196	w_p%nc=1
197	w_p%fc='(1((1X,a72)))'
198	write(w_p%c(1),'(1x,i4,a21)') el%kind," not supported TRACKR"
199	! call !write_e(0)
200	END SELECT
201	END SUBROUTINE TRACKR
202
203	SUBROUTINE TRACKP(EL,X,K)
204	IMPLICIT NONE
205	TYPE(REAL_8),INTENT(INOUT):: X(6)
206	TYPE(ELEMENTP),INTENT(INOUT):: EL
207	! TYPE(WORM_8),OPTIONAL, INTENT(INOUT):: MID
208	TYPE(INTERNAL_STATE) K
209
210	if(associated(el%p%aperture)) call CHECK_APERTURE(EL%p%aperture,X)
211	! if(other_program) then
212	! call track_p(x)
213	! return
214	! endif
215	SELECT CASE(EL%KIND)
216	CASE(KIND0)
217	! IF(PRESENT(MID)) CALL XMID(MID,X,0)
218	case(KIND1)
219	CALL TRACK(EL%D0,X,K)
220	case(KIND2)
221	CALL TRACK(EL%K2,X,k)
222	case(KIND3)
223	CALL TRACK(EL%K3,X,k)
224	case(KIND4)
225	CALL TRACK(EL%C4,X,k)
226	case(KIND5)
227	CALL TRACK(EL%S5,X,k)
228	case(KIND6)
229	CALL TRACK(EL%T6,X,k)
230	case(KIND7)
231	CALL TRACK(EL%T7,X,k)
232	case(KIND8)
233	CALL TRACK(EL%S8,X,k)
234	case(KIND9)
235	CALL TRACK(EL%S9,X,k)
236	case(KIND10)
237	CALL TRACK(EL%TP10,X,k)
238	CASE(KIND11:KIND14)
239	call TRACK(EL%MON14,X,k)
240	CASE(KIND15)
241	call TRACK(EL%SEP15,X,k)
242	CASE(KIND16,KIND20)
243	call TRACK(EL%K16,X,k)
244	CASE(KIND18)
245	call TRACK(EL%RCOL18,X,k)
246	CASE(KIND19)
247	call TRACK(EL%ECOL19,X,k)
248	CASE(KIND21)
249	call TRACK(EL%CAV21,X,k)
250	CASE(KIND22)
251	call TRACK(EL%HE22,X,k)
252	case(KINDWIGGLER)
253	call TRACK(EL%WI,X,k)
254	case(KINDPA)
255	call TRACK(EL%PA,X,k)
256	case default
257	w_p=0
258	w_p%nc=1
259	w_p%fc='(1((1X,a72)))'
260	write(w_p%c(1),'(1x,i4,a21)') el%kind," not supported TRACKP"
261	! call !write_e(0)
262	END SELECT
263	END SUBROUTINE TRACKP
264
265	! SUBROUTINE TRACK_R(X)
266	! IMPLICIT NONE
267	! REAL(DP) X(6),x6,xp,yp
268	! INTEGER icharef
269	! COMMON/ptc/ icharef
270	!
271	!
272	! if(j_global==1) return ! skipping OBJECT OF ZGOUBI = TRACKING COMMAND INTERNAL TO ZGOUBI
273	! icharef=0
274	!
275	! x(1)=x(1)*c_100
276	! x(3)=x(3)*c_100
277	! x6=x(6)*c_100
278	!
279	! xp=x(2)/root((one+x(5))2-x(2)2-x(4)**2)
280	! yp=x(4)/root((one+x(5))2-x(2)2-x(4)**2)
281	! x(2)=atan(xp)*c_1d3
282	! x(4)=atan(yp/root(one+xp*2))c_1d3
283	!
284	! x(6)=x(5)
285	! x(5)=x6
286	!
287	! !call track_z(x,j_global,j_global)
288	!
289	! x6=x(5)/c_100
290	! x(5)=x(6)
291	! x(6)=x6
292	!
293	! x(1)=x(1)/c_100
294	! x(3)=x(3)/c_100
295	! xp=tan(x(2)/c_1d3)
296	! yp=tan(x(4)/c_1d3)root(one+xp*2)
297
298	! x(2)=(one+x(5))xp/root(one+xp2+yp*2)
299	! x(4)=(one+x(5))yp/root(one+xp2+yp*2)
300
301	! icharef=1
302
303	! END SUBROUTINE TRACK_R
304
305	! SUBROUTINE TRACK_P(X)
306	! IMPLICIT NONE
307	! TYPE(REAL_8) X(6)
308
309	! track_zp is a fortran external routine using numerical differentiation
310	!call track_zp(x,j_global,j_global)
311	! WRITE(6,*) " NOT SUPPORTED "
312	! STOP 111
313	! END SUBROUTINE TRACK_P
314
315
316
317
318	SUBROUTINE work_0(S2,S1)
319	implicit none
320	type (work),INTENT(inOUT):: S2
321	INTEGER,INTENT(IN):: S1
322
323	S2%BETA0=1.0_dp
324	S2%energy=0.0_dp
325	S2%kinetic=0.0_dp
326	S2%p0c=0.0_dp
327	S2%brho=0.0_dp
328	S2%mass=0.0_dp
329	S2%gamma0I=0.0_dp
330	S2%gambet=0.0_dp
331	if(s1/=0) then
332	S2%rescale=.true.
333	s2%power=s1
334	else
335	S2%rescale=.false.
336	s2%power=0
337	endif
338	END SUBROUTINE work_0
339
340
341
342	SUBROUTINE work_r(S2,S1)
343	implicit none
344	type (work),INTENT(inOUT):: S2
345	real(dp),INTENT(IN):: S1
346
347	! S2%energy=-(S2%energy+s1)
348	! VERBOSE = .FALSE.
349	IF(FEED_P0C) THEN
350	call find_energy(s2,P0C=S1+S2%P0C)
351	ELSE
352	call find_energy(s2,ENERGY=S1+S2%energy)
353	ENDIF
354	! VERBOSE = .TRUE.
355	END SUBROUTINE work_r
356
357	SUBROUTINE print_work(S2,mf)
358	implicit none
359	type (work),INTENT(inOUT):: S2
360	integer,INTENT(IN):: mf
361
362	write(mf,*) "Beta0 = ",s2%beta0
363	write(mf,*) "Mass = ",s2%mass
364	write(mf,*) "Energy = ",s2%Energy
365	write(mf,*) "Kinetic Energy = ",s2%kinetic
366	write(mf,*) "p0c = ",s2%p0c
367	write(mf,*) "gamma = ",1.d0/s2%gamma0i
368	write(mf,*) "p0c = ",s2%p0c
369	write(mf,*) "brho = ",s2%brho
370	write(mf,*) "rescale and power = ",s2%rescale,s2%power
371
372
373	END SUBROUTINE print_work
374
375	function unaryw_w(S1)
376	implicit none
377	type (WORK),INTENT(IN):: S1
378	TYPE(WORK) unaryw_w
379	unaryw_w=s1
380	unaryw_w%rescale=.false.
381
382	end function unaryw_w
383
384	SUBROUTINE ELp_WORK(S2,S1)
385	implicit none
386	type (WORK),INTENT(IN):: S1
387	TYPE(ELEMENTP),INTENT(inOUT):: S2
388	integer i
389
390	if(s1%rescale) then
391	if(s2%p%nmul/=0) then ! doing for crab also
392	do i=1,s2%P%nmul
393	s2%bn(i)=s2%bn(i)(S2%P%P0C/S1%P0C)*S1%power
394	s2%an(i)=s2%an(i)(S2%P%P0C/S1%P0C)*S1%power
395	enddo
396	CALL ADD(s2,1,1,0.0_dp)
397	endif
398	if(associated(s2%B_sol)) s2%B_sol=s2%B_sol(S2%P%P0C/S1%P0C)*S1%power
399
400	! if(s2%kind==kinduser1) call scale_user1(s2%u1,S2%P%P0C,S1%P0C,S1%power)
401	! if(s2%kind==kinduser2) call scale_user2(s2%u2,S2%P%P0C,S1%P0C,S1%power)
402	if(s2%kind==KINDwiggler) call scale_sagan(s2%wi,S2%P%P0C,S1%P0C,S1%power)
403
404	endif
405
406	if(S1%power/=-1) then ! just rescaling -1=ramping
407	! S2%P%BETA0=S1%BETA0
408	! S2%P%GAMMA0I=S1%GAMMA0I
409	! S2%P%GAMBET=S1%GAMBET
410	S2%P%P0C=S1%P0C
411	endif
412
413	END SUBROUTINE ELp_WORK
414
415	SUBROUTINE EL_WORK(S2,S1)
416	implicit none
417	type (WORK),INTENT(IN):: S1
418	TYPE(ELEMENT),INTENT(inOUT):: S2
419	integer i
420
421	if(s1%rescale) then
422	if(s2%p%nmul/=0) then
423	do i=1,s2%P%nmul
424	s2%bn(i)=s2%bn(i)(S2%P%P0C/S1%P0C)*S1%power
425	s2%an(i)=s2%an(i)(S2%P%P0C/S1%P0C)*S1%power
426	enddo
427	CALL ADD(s2,1,1,0.0_dp)
428	endif
429	if(associated(s2%B_sol)) s2%B_sol=s2%B_sol(S2%P%P0C/S1%P0C)*S1%power
430	! if(s2%kind==kinduser1) call scale_user1(s2%u1,S2%P%P0C,S1%P0C,S1%power)
431	! if(s2%kind==kinduser2) call scale_user2(s2%u2,S2%P%P0C,S1%P0C,S1%power)
432	if(s2%kind==KINDwiggler) call scale_sagan(s2%wi,S2%P%P0C,S1%P0C,S1%power)
433	endif
434
435
436	if(S1%power/=-1) then ! just rescaling -1=ramping
437	! S2%P%BETA0=S1%BETA0
438	! S2%P%GAMMA0I=S1%GAMMA0I
439	! S2%P%GAMBET=S1%GAMBET
440	S2%P%P0C=S1%P0C
441	endif
442
443
444	END SUBROUTINE EL_WORK
445
446
447	SUBROUTINE WORK_EL(S1,S2)
448	implicit none
449	type (WORK),INTENT(inOUT):: S1
450	TYPE(ELEMENT),INTENT(IN):: S2
451
452	S1=S1%POWER
453
454	! S1%P0C=-S2%P%P0C
455	! VERBOSE = .FALSE.
456	call find_energy(s1,P0C=S2%P%P0C)
457	! VERBOSE = .TRUE.
458
459	END SUBROUTINE WORK_EL
460
461	SUBROUTINE WORK_ELp(S1,S2)
462	implicit none
463	type (WORK),INTENT(inOUT):: S1
464	TYPE(ELEMENTP),INTENT(IN):: S2
465
466	S1=S1%POWER
467
468	! S1%P0C=-S2%P%P0C
469	! VERBOSE = .FALSE.
470	call find_energy(s1,P0C=S2%P%P0C)
471	! VERBOSE = .TRUE.
472
473	END SUBROUTINE WORK_ELp
474
475
476	integer function mod_n(i,j)
477	implicit none
478	integer, intent(in) :: i,j
479	integer k
480	if(j<=0) then
481	w_p=0
482	w_p%nc=1
483	w_p%fc='(1((1X,A72)))'
484	write(w_p%c(1),'(A4,1X,I4)') "j = ",j
485	! call !write_e(812)
486	endif
487	k=i
488	if(i<1) then
489	do while(k<1)
490	k=k+j
491	enddo
492	endif
493	mod_n=mod(k,j)
494	if(mod_n==0) mod_n=j
495	end function mod_n
496
497	SUBROUTINE bL_0(S2,S1)
498	implicit none
499	type (MUL_BLOCK),INTENT(OUT):: S2
500	INTEGER,INTENT(IN):: S1
501	INTEGER I
502
503	IF(S1>=0.OR.S1<=nmax) THEN
504	do i = 1,nmax
505	s2%aN(i)=0.0_dp
506	s2%bN(i)=0.0_dp
507	enddo
508	s2%natural=1
509	s2%nmul=S1
510	s2%ADD=0
511	ELSEIF(S1>NMAX) THEN
512	w_p=0
513	w_p%nc=1
514	w_p%fc='(1((1X,A72)))'
515	write(w_p%c(1),'(A38,1X,I4)') " NMAX NOT BIG ENOUGH: PLEASE INCREASE ",NMAX
516	! call !write_e(100)
517	ELSE
518	w_p=0
519	w_p%nc=1
520	w_p%fc='(1((1X,A72)))'
521	w_p%c(1) = " UNDEFINED ASSIGNMENT IN BL_0"
522	! call !write_e(101)
523	ENDIF
524
525	END SUBROUTINE bL_0
526
527	SUBROUTINE bLPOL_0(S2,S1)
528	implicit none
529	type (POL_BLOCK),INTENT(OUT):: S2
530	INTEGER,INTENT(IN):: S1
531	INTEGER I
532
533	! IF(S1>=0.and.S1<=nmax) THEN
534	do i = 1,nmax
535	s2%SAN(i)=1.0_dp
536	s2%SBN(i)=1.0_dp
537	s2%IaN(i)=0
538	s2%IbN(i)=0
539	enddo
540	! S2%user1=0
541	! S2%user2=0
542	S2%SAGAN=0
543	S2%SVOLT=1.0_dp
544	S2%SFREQ=1.0_dp
545	S2%SPHAS=1.0_dp
546	S2%SB_SOL=1.0_dp
547	S2%IVOLT=0
548	S2%IFREQ=0
549	S2%IPHAS=0
550	S2%IB_SOL=0
551	s2%npara=S1
552	s2%g=0
553	s2%np=0
554	s2%nb=0
555	! s2%NMUL=0
556	s2%NAME=' '
557	s2%N_NAME=0
558	s2%VORNAME=' '
559	! s2%CHECK_NMUL=.TRUE.
560	nullify(s2%tpsafit);nullify(s2%set_tpsafit);
561	nullify(s2%set_ELEMENT);
562
563	IF(USE_TPSAFIT) then
564	s2%tpsafit=>tpsafit
565	s2%set_tpsafit=>set_tpsafit
566	s2%set_ELEMENT=>set_ELEMENT
567	endif
568
569	if(s1>0) then
570	c_%npara_fpp=0 ! backwards compatible
571	endif
572
573	END SUBROUTINE bLPOL_0
574
575	SUBROUTINE BL_EL(S1,S2)
576	implicit none
577	type (MUL_BLOCK),INTENT(out):: S1
578	TYPE(ELEMENT),INTENT(IN):: S2
579	INTEGER I
580
581	IF(S2%P%NMUL>NMAX) THEN
582	w_p=0
583	w_p%nc=1
584	w_p%fc='(1((1X,A72)))'
585	write(w_p%c(1),'(A21,1X,I4,1X,I4)') " NMAX NOT BIG ENOUGH ", S2%P%NMUL,NMAX
586	! call !write_e(456)
587	ENDIF
588	S1=S2%P%NMUL
589
590	DO I=1,S2%P%NMUL
591	s1%AN(I)=s2%AN(I)
592	s1%BN(I)=s2%BN(I)
593	ENDDO
594
595	END SUBROUTINE BL_EL
596
597	SUBROUTINE BL_ELP(S1,S2)
598	implicit none
599	type (MUL_BLOCK),INTENT(out):: S1
600	TYPE(ELEMENTP),INTENT(IN):: S2
601	INTEGER I
602
603	IF(S2%P%NMUL>NMAX) THEN
604	w_p=0
605	w_p%nc=1
606	w_p%fc='(1((1X,A72)))'
607	write(w_p%c(1),'(A21,1X,I4,1X,I4)') " NMAX NOT BIG ENOUGH ", S2%P%NMUL,NMAX
608	! call !write_e(456)
609	ENDIF
610	S1=S2%P%NMUL
611
612	DO I=1,S2%P%NMUL
613	s1%AN(I)=s2%AN(I)
614	s1%BN(I)=s2%BN(I)
615	ENDDO
616
617	END SUBROUTINE BL_ELP
618
619	SUBROUTINE EL_BL(S2,S1)
620	implicit none
621	type (MUL_BLOCK),INTENT(IN):: S1
622	TYPE(ELEMENT),INTENT(inOUT):: S2
623	INTEGER I
624
625	IF(S2%P%NMUL>NMAX) THEN
626	w_p=0
627	w_p%nc=1
628	w_p%fc='(1((1X,A72)))'
629	write(w_p%c(1),'(A21,1X,I4,1X,I4)') " NMAX NOT BIG ENOUGH ", S2%P%NMUL,NMAX
630	! call !write_e(456)
631	ENDIF
632	IF(s1%nmul>s2%P%nmul) CALL ADD(s2,s1%nmul,1,0.0_dp)
633
634	DO I=1,S2%P%NMUL
635	s2%AN(I)=S1%ADD*s2%AN(I)+s1%AN(I)
636	s2%BN(I)=S1%ADD*s2%BN(I)+s1%BN(I)
637	ENDDO
638	CALL ADD(s2,1,1,0.0_dp)
639
640	END SUBROUTINE EL_BL
641
642	SUBROUTINE ELp_BL(S2,S1)
643	implicit none
644	type (MUL_BLOCK),INTENT(IN):: S1
645	TYPE(ELEMENTP),INTENT(inOUT):: S2
646	INTEGER I
647
648	IF(S2%P%NMUL>NMAX) THEN
649	w_p=0
650	w_p%nc=1
651	w_p%fc='(1((1X,A72)))'
652	write(w_p%c(1),'(A21,1X,I4,1X,I4)') " NMAX NOT BIG ENOUGH ", S2%P%NMUL,NMAX
653	! call !write_e(456)
654	ENDIF
655
656	IF(s1%nmul>s2%P%nmul) CALL ADD(s2,s1%nmul,1,0.0_dp)
657	DO I=1,S2%P%NMUL
658	s2%AN(I)=S1%ADD*s2%AN(I)+s1%AN(I)
659	s2%BN(I)=S1%ADD*s2%BN(I)+s1%BN(I)
660	ENDDO
661	CALL ADD(s2,1,1,0.0_dp)
662
663
664	END SUBROUTINE ELp_BL
665
666	SUBROUTINE ELp_POL(S2,S1)
667	implicit none
668	type (POL_BLOCK),INTENT(IN):: S1
669	TYPE(ELEMENTP),INTENT(inOUT):: S2
670	logical(lp) DOIT !,checkname
671	CHARACTER(nlp) S1NAME
672	CHARACTER(vp) S1VORNAME
673
674
675	IF(S2%P%NMUL>NMAX) THEN
676	w_p=0
677	w_p%nc=1
678	w_p%fc='(1((1X,A72)))'
679	write(w_p%c(1),'(A21,1X,I4,1X,I4)') " NMAX NOT BIG ENOUGH ", S2%P%NMUL,NMAX
680	! call !write_e(456)
681	ENDIF
682
683	S1NAME=S1%name
684	S1VORNAME=S1%VORname
685	CALL CONTEXT(S1name)
686	CALL CONTEXT(S1vorname)
687	CALL CONTEXT(S2%name)
688	CALL CONTEXT(S2%vorname)
689
690	DOIT=.TRUE.
691	IF(S1NAME/=' ') THEN
692	if(s1%n_name==0) then
693	IF(S1NAME/=S2%NAME) DOIT=.FALSE.
694	else
695	IF(S1NAME(1:s1%n_name)/=S2%NAME(1:s1%n_name)) DOIT=.FALSE.
696	endif
697	ENDIF
698
699
700	IF(S1VORNAME/=' ') THEN
701	IF(S1VORNAME/=S2%VORNAME.or.S1NAME/=S2%NAME) DOIT=.FALSE.
702	ENDIF
703
704
705	IF(DOIT) THEN
706	IF(.not.S1%SET_TPSAFIT.AND.(.NOT.SET_ELEMENT)) THEN
707	if(s2%knob) then
708	write(6,'(A45,A16)')" BE CAREFUL USING A POL_BLOCK ON SAME MAGNET ",S2%NAME
709	ENDIF
710	endif
711	s2%knob=.TRUE.
712	call ELp_POL_force(S2,S1)
713	ENDIF
714
715
716	END SUBROUTINE ELp_POL
717
718	SUBROUTINE ELp_POL_force(S2,S1)
719	implicit none
720	type (POL_BLOCK),INTENT(IN):: S1
721	TYPE(ELEMENTP),INTENT(inOUT):: S2
722	INTEGER I,S1NMUL
723	logical(lp) DOIT,DONEIT !,checkname
724
725	IF(S2%P%NMUL>NMAX) THEN
726	w_p=0
727	w_p%nc=1
728	w_p%fc='(1((1X,A72)))'
729	write(w_p%c(1),'(A21,1X,I4,1X,I4)') " NMAX NOT BIG ENOUGH ", S2%P%NMUL,NMAX
730	! call !write_e(456)
731	ENDIF
732
733
734	DOIT=.TRUE.
735
736
737
738	s2%knob=.TRUE.
739
740	! IF(S1%NPARA>=4.AND.S1%NPARA<=6) THEN
741	DONEIT=.FALSE.
742
743	! IF(S1%CHECK_NMUL) THEN
744	S1NMUL=0
745	DO I=NMAX,1,-1
746	IF(s1%IAN(I)/=0.OR.s1%IBN(I)/=0) THEN
747	S1NMUL=I
748	if(s1%IAN(I)>c_%np_pol) c_%np_pol=s1%IAN(I)
749	if(s1%IBN(I)>c_%np_pol) c_%np_pol=s1%IBN(I)
750	GOTO 100
751	ENDIF
752	ENDDO
753	100 CONTINUE
754	! CALL SET_FALSE(S1%CHECK_NMUL)
755	! ENDIF
756
757	IF(S1NMUL>S2%P%NMUL) then
758	CALL ADD(S2,S1NMUL,1,0.0_dp) !etienne
759	endif
760	DO I=1,S1NMUL
761	IF(S1%IAN(I)>0) THEN
762	s2%AN(I)%I=S1%IAN(I)+S1%NPARA
763	s2%AN(I)%S=S1%SAN(I)
764	s2%AN(I)%KIND=3
765	s2%AN(I)%g=S1%g
766	s2%AN(I)%nb=S1%nb
767	DONEIT=.TRUE.
768	IF(S1%SET_TPSAFIT) THEN
769	s2%aN(I)%R=s2%aN(I)%R+scale_tpsafits2%AN(I)%Ss1%TPSAFIT(S1%IAN(I))
770	ENDIF
771	IF(S1%SET_ELEMENT) THEN
772	s2%PARENT_FIBRE%MAG%aN(I)=s2%aN(I)%R
773	ENDIF
774	ENDIF
775	IF(S1%IBN(I)>0) THEN
776	s2%BN(I)%I=S1%IBN(I)+S1%NPARA
777	s2%BN(I)%S=S1%SBN(I)
778	s2%BN(I)%KIND=3
779	s2%BN(I)%g=S1%g
780	s2%BN(I)%nb=S1%nb
781	DONEIT=.TRUE.
782	IF(S1%SET_TPSAFIT) THEN
783	s2%BN(I)%R=s2%BN(I)%R+scale_tpsafits2%BN(I)%Ss1%TPSAFIT(S1%IBN(I))
784	ENDIF
785	IF(S1%SET_ELEMENT) THEN
786	s2%PARENT_FIBRE%MAG%BN(I)=s2%BN(I)%R
787	ENDIF
788	ENDIF
789	ENDDO
790	IF(DONEIT.AND.(S1%SET_TPSAFIT.OR.S1%SET_ELEMENT)) THEN
791	CALL ADD(S2,1,1,0.0_dp) !etienne
792	ENDIF
793	IF(S2%KIND==KIND4) THEN ! CAVITY
794	DONEIT=.FALSE. ! NOT USED HERE
795	IF(S1%IVOLT>0) THEN
796	s2%VOLT%I=S1%IVOLT+S1%NPARA
797	s2%VOLT%S=S1%SVOLT
798	s2%VOLT%KIND=3
799	s2%VOLT%g=S1%g
800	s2%VOLT%nb=S1%nb
801	DONEIT=.TRUE.
802	if(S1%IVOLT>c_%np_pol) c_%np_pol=S1%IVOLT
803	IF(S1%SET_TPSAFIT) THEN
804	s2%VOLT%R=s2%VOLT%R+scale_tpsafits2%VOLT%Ss1%TPSAFIT(S1%IVOLT)
805	ENDIF
806	IF(S1%SET_ELEMENT) THEN
807	s2%PARENT_FIBRE%MAG%VOLT=s2%VOLT%R
808	ENDIF
809	ENDIF
810	IF(S1%IFREQ>0) THEN
811	s2%FREQ%I=S1%IFREQ+S1%NPARA
812	s2%FREQ%S=S1%SFREQ
813	s2%FREQ%g=S1%g
814	s2%FREQ%nb=S1%nb
815	s2%FREQ%KIND=3
816	if(S1%IFREQ>c_%np_pol) c_%np_pol=S1%IFREQ
817	IF(S1%SET_TPSAFIT) THEN
818	s2%FREQ%R=s2%FREQ%R+scale_tpsafits2%FREQ%Ss1%TPSAFIT(S1%IFREQ)
819	ENDIF
820	IF(S1%SET_ELEMENT) THEN
821	s2%PARENT_FIBRE%MAG%FREQ=s2%FREQ%R
822	ENDIF
823	DONEIT=.TRUE.
824	ENDIF
825	IF(S1%IPHAS>0) THEN
826	s2%PHAS%I=S1%IPHAS+S1%NPARA
827	s2%PHAS%S=S1%SPHAS
828	s2%PHAS%KIND=3
829	s2%PHAS%g=S1%g
830	s2%PHAS%nb=S1%nb
831	DONEIT=.TRUE.
832	if(S1%IPHAS>c_%np_pol) c_%np_pol=S1%IPHAS
833	IF(S1%SET_TPSAFIT) THEN
834	s2%PHAS%R=s2%PHAS%R+scale_tpsafits2%PHAS%Ss1%TPSAFIT(S1%IPHAS)
835	ENDIF
836	IF(S1%SET_ELEMENT) THEN
837	s2%PARENT_FIBRE%MAG%PHAS=s2%PHAS%R
838	ENDIF
839	ENDIF
840	ENDIF
841	IF(S2%KIND==KIND21) THEN ! CAVITY
842	DONEIT=.FALSE. ! NOT USED HERE
843	IF(S1%IVOLT>0) THEN
844	s2%VOLT%I=S1%IVOLT+S1%NPARA
845	s2%VOLT%S=S1%SVOLT
846	s2%PHAS%g=S1%g
847	s2%PHAS%nb=S1%nb
848	s2%VOLT%KIND=3
849	if(S1%IVOLT>c_%np_pol) c_%np_pol=S1%IVOLT
850	DONEIT=.TRUE.
851	IF(S1%SET_TPSAFIT) THEN
852	s2%VOLT%R=s2%VOLT%R+scale_tpsafits2%VOLT%Ss1%TPSAFIT(S1%IVOLT)
853	ENDIF
854	IF(S1%SET_ELEMENT) THEN
855	s2%PARENT_FIBRE%MAG%VOLT=s2%VOLT%R
856	ENDIF
857	ENDIF
858	IF(S1%IFREQ>0) THEN
859	s2%FREQ%I=S1%IFREQ+S1%NPARA
860	s2%FREQ%S=S1%SFREQ
861	s2%FREQ%g=S1%g
862	s2%FREQ%nb=S1%nb
863	s2%FREQ%KIND=3
864	if(S1%IFREQ>c_%np_pol) c_%np_pol=S1%IFREQ
865	IF(S1%SET_TPSAFIT) THEN
866	s2%FREQ%R=s2%FREQ%R+scale_tpsafits2%FREQ%Ss1%TPSAFIT(S1%IFREQ)
867	ENDIF
868	IF(S1%SET_ELEMENT) THEN
869	s2%PARENT_FIBRE%MAG%FREQ=s2%FREQ%R
870	ENDIF
871	DONEIT=.TRUE.
872	ENDIF
873	IF(S1%IPHAS>0) THEN
874	s2%PHAS%I=S1%IPHAS+S1%NPARA
875	s2%PHAS%S=S1%SPHAS
876	s2%PHAS%g=S1%g
877	s2%PHAS%nb=S1%nb
878	s2%PHAS%KIND=3
879	if(S1%IPHAS>c_%np_pol) c_%np_pol=S1%IPHAS
880	DONEIT=.TRUE.
881	IF(S1%SET_TPSAFIT) THEN
882	s2%PHAS%R=s2%PHAS%R+scale_tpsafits2%PHAS%Ss1%TPSAFIT(S1%IPHAS)
883	ENDIF
884	IF(S1%SET_ELEMENT) THEN
885	s2%PARENT_FIBRE%MAG%PHAS=s2%PHAS%R
886	ENDIF
887	ENDIF
888	ENDIF
889	IF(S2%KIND==KIND5) THEN ! SOLENOID
890	DONEIT=.FALSE.
891	IF(S1%IB_SOL>0) THEN
892	s2%B_SOL%I=S1%IB_SOL+S1%NPARA
893	s2%B_SOL%S=S1%SB_SOL
894	s2%B_SOL%g=S1%g
895	s2%B_SOL%nb=S1%nb
896	s2%B_SOL%KIND=3
897	DONEIT=.TRUE.
898	if(S1%IB_SOL>c_%np_pol) c_%np_pol=S1%IB_SOL
899	IF(S1%SET_TPSAFIT) THEN
900	s2%B_SOL%R=s2%B_SOL%R+scale_tpsafits2%B_SOL%Ss1%TPSAFIT(S1%IB_SOL)
901	ENDIF
902	IF(S1%SET_ELEMENT) THEN
903	s2%PARENT_FIBRE%MAG%B_SOL=s2%B_SOL%R
904	ENDIF
905	ENDIF
906	ENDIF
907	! IF(S2%KIND==kinduser1) THEN ! new element
908	! DONEIT=.FALSE. ! NOT USED HERE
909	! call ELp_POL_user1(S2%u1,S1,DONEIT)
910	! ENDIF
911	! IF(S2%KIND==kinduser2) THEN ! new element
912	! DONEIT=.FALSE. ! NOT USED HERE
913	! call ELp_POL_user2(S2%u2,S1,DONEIT)
914	! ENDIF
915	IF(S2%KIND==KINDWIGGLER) THEN ! new element
916	DONEIT=.FALSE. ! NOT USED HERE
917	call ELp_POL_SAGAN(S2%WI,S2%PARENT_FIBRE%MAG%WI,S1,DONEIT)
918	ENDIF
919
920
921
922	END SUBROUTINE ELp_POL_force
923
924	SUBROUTINE ELp_POL_print(S2)
925	implicit none
926	TYPE(ELEMENTP),INTENT(inOUT):: S2
927	INTEGER I
928	type(work) w
929
930
931
932	! CALL SET_FALSE(S1%CHECK_NMUL)
933	! ENDIF
934
935	DO I=1,S2%P%NMUL
936	IF(s2%AN(I)%KIND==3) THEN
937	w=s2
938	write(mfpolbloc,'(a16,a8,1x,i4,2(1x,e18.8))') s2%name, ' MAD AN ',i,s2%aN(I)%RMADFAC(I),s2%aN(I)%Rw%brho*MADFAC(I)
939	ENDIF
940	IF(s2%bN(I)%KIND==3) THEN
941	w=s2
942	write(mfpolbloc,'(a16,a8,1x,i4,2(1x,e18.8))') s2%name, ' MAD BN ',i,s2%BN(I)%RMADFAC(I),s2%BN(I)%Rw%brho*MADFAC(I)
943	endif
944	ENDDO
945	IF(S2%KIND==KIND4.or.S2%KIND==KIND21) THEN ! CAVITY
946	IF(s2%VOLT%KIND==3) THEN
947	write(mfpolbloc,*) s2%name, ' VOLT ',s2%VOLT%R
948	ENDIF
949	IF(s2%FREQ%KIND==3) THEN
950	write(mfpolbloc,*) s2%name, ' FREQ ',s2%FREQ%R
951	ENDIF
952	IF(s2%PHAS%KIND==3) THEN
953	write(mfpolbloc,*) s2%name, ' PHAS ',s2%PHAS%R
954	ENDIF
955	ENDIF
956	IF(S2%KIND==KIND5) THEN ! SOLENOID
957	IF(s2%B_SOL%KIND==3) THEN
958	write(mfpolbloc,*) s2%name, ' B_SOL ',s2%B_SOL%R
959	ENDIF
960	ENDIF
961
962	! IF(S2%KIND==KINDWIGGLER) THEN ! new element
963	! DONEIT=.FALSE. ! NOT USED HERE
964	! call ELp_POL_SAGAN(S2%WI,S1,DONEIT)
965	! ENDIF
966
967
968
969	END SUBROUTINE ELp_POL_print
970
971
972
973
974
975	SUBROUTINE COPY_BL(S1,S2)
976	implicit none
977	type (MUL_BLOCK),INTENT(IN):: S1
978	TYPE(MUL_BLOCK),INTENT(OUT):: S2
979	INTEGER I
980
981	DO I=1,NMAX
982	s2%AN(I)=s1%AN(I)
983	s2%BN(I)=S1%BN(I)
984	ENDDO
985
986	S2%NMUL =S1%NMUL
987	S2%ADD =S1%ADD
988	S2%NATURAL =S1%NATURAL
989
990	END SUBROUTINE COPY_BL
991
992
993	FUNCTION UNARYP_BL(S1)
994	implicit none
995	type (MUL_BLOCK),INTENT(IN):: S1
996	type (MUL_BLOCK) UNARYP_BL
997
998	CALL COPY(S1,UNARYP_BL)
999	UNARYP_BL%ADD=1
1000
1001	END FUNCTION UNARYP_BL
1002
1003
1004
1005
1006	! SUBROUTINE SETFAMILYR(EL,T,t_ax,t_ay,NTOT,ntot_rad,NTOT_REV,ntot_rad_REV,ND2)
1007	SUBROUTINE SETFAMILYR(EL,T) !,NTOT,ntot_rad,NTOT_REV,ntot_rad_REV,ND2)
1008	IMPLICIT NONE
1009	TYPE(ELEMENT), INTENT(INOUT) ::EL
1010	! INTEGER,OPTIONAL :: NTOT,ntot_rad,NTOT_REV,ntot_rad_REV,ND2
1011	type(tree_element),OPTIONAL :: T(:) !,t_ax(:),t_ay(:)
1012	! EL%P%permfringe=>EL%permfringe
1013	SELECT CASE(EL%KIND)
1014	CASE(KIND1)
1015	if(.not.ASSOCIATED(EL%D0))ALLOCATE(EL%D0)
1016	EL%D0%P=>EL%P
1017	EL%D0%L=>EL%L
1018	CASE(KIND2)
1019	IF(EL%P%EXACT) THEN
1020	w_p=0
1021	w_p%nc=2
1022	w_p%fc='((1X,A72,/,1X,A72))'
1023	w_p%c(1)=" ERROR IN SETFAMILYR "
1024	write(w_p%c(2),'(A37,1x,I4)') " EXACT OPTION NOT SUPPORTED FOR KIND ", EL%KIND
1025	! call !write_e(222)
1026	ENDIF
1027	if(.not.ASSOCIATED(EL%K2)) THEN
1028	ALLOCATE(EL%K2)
1029	EL%K2=0
1030	ELSE
1031	EL%K2=-1
1032	EL%K2=0
1033	ENDIF
1034	! if(.not.ASSOCIATED(EL%K2))ALLOCATE(EL%K2)
1035	EL%K2%P=>EL%P
1036	EL%K2%L=>EL%L
1037	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1038	EL%K2%AN=>EL%AN
1039	EL%K2%BN=>EL%BN
1040	EL%K2%FINT=>EL%FINT
1041	EL%K2%HGAP=>EL%HGAP
1042	EL%K2%H1=>EL%H1
1043	EL%K2%H2=>EL%H2
1044	EL%K2%VA=>EL%VA
1045	EL%K2%VS=>EL%VS
1046	NULLIFY(EL%K2%F);ALLOCATE(EL%K2%F);EL%K2%F=1;
1047	CASE(KIND3)
1048	if(.not.ASSOCIATED(EL%K3)) THEN
1049	ALLOCATE(EL%K3)
1050	el%K3=0
1051	ELSE
1052	el%K3=-1
1053	el%K3=0
1054	ENDIF
1055	EL%K3%P=>EL%P
1056	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1057	EL%K3%AN=>EL%AN
1058	EL%K3%BN=>EL%BN
1059	ALLOCATE(EL%K3%ls);EL%K3%ls=1.0_dp
1060	ALLOCATE(EL%K3%hf);EL%K3%hf=0
1061	ALLOCATE(EL%K3%vf);EL%K3%vf=0
1062	ALLOCATE(EL%K3%thin_h_foc);EL%K3%thin_h_foc=0
1063	ALLOCATE(EL%K3%thin_v_foc);EL%K3%thin_v_foc=0
1064	ALLOCATE(EL%K3%thin_h_angle);EL%K3%thin_h_angle=0
1065	ALLOCATE(EL%K3%thin_v_angle);EL%K3%thin_v_angle=0
1066	ALLOCATE(EL%K3%patch);EL%K3%patch=my_false
1067	EL%K3%B_SOL=>EL%B_SOL
1068	CASE(KIND4)
1069	if(.not.ASSOCIATED(EL%C4)) THEN
1070	ALLOCATE(EL%C4)
1071	el%C4=0
1072	ELSE
1073	el%C4=-1
1074	el%C4=0
1075	ENDIF
1076	EL%C4%P=>EL%P
1077	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1078	EL%C4%AN=>EL%AN
1079	EL%C4%BN=>EL%BN
1080	EL%C4%L=>EL%L
1081	EL%C4%VOLT=>EL%VOLT
1082	EL%C4%FREQ=>EL%FREQ
1083	EL%C4%PHAS=>EL%PHAS
1084	! EL%C4%P0C=>EL%P0C
1085	EL%C4%DELTA_E=>EL%DELTA_E
1086	EL%C4%THIN=>EL%THIN
1087	ALLOCATE(EL%C4%N_BESSEL);EL%C4%N_BESSEL=0
1088	ALLOCATE(EL%C4%cavity_totalpath);EL%C4%cavity_totalpath=cavity_totalpath
1089	ALLOCATE(EL%C4%phase0);EL%C4%phase0=phase0
1090	ALLOCATE(EL%C4%NF);EL%C4%NF=N_CAV4_F
1091	ALLOCATE(EL%C4%F(N_CAV4_F));EL%C4%F=0.0_dp;EL%C4%F(1)=1.0_dp;
1092	ALLOCATE(EL%C4%A);EL%C4%A=0.0_dp;
1093	ALLOCATE(EL%C4%R);EL%C4%R=1.0_dp;
1094	ALLOCATE(EL%C4%always_on);EL%C4%always_on=my_false;
1095	ALLOCATE(EL%C4%PH(N_CAV4_F));EL%C4%PH=0.0_dp;
1096	ALLOCATE(EL%C4%t);EL%C4%t=0.0_dp;
1097
1098	CASE(KIND21)
1099	if(.not.ASSOCIATED(EL%CAV21)) THEN
1100	ALLOCATE(EL%CAV21)
1101	el%CAV21=0
1102	ELSE
1103	el%CAV21=-1
1104	el%CAV21=0
1105	ENDIF
1106	EL%CAV21%P=>EL%P
1107	EL%CAV21%L=>EL%L
1108	EL%CAV21%VOLT=>EL%VOLT
1109	EL%CAV21%FREQ=>EL%FREQ
1110	EL%CAV21%PHAS=>EL%PHAS
1111	! EL%C4%P0C=>EL%P0C
1112	EL%CAV21%DELTA_E=>EL%DELTA_E
1113	EL%CAV21%THIN=>EL%THIN
1114	ALLOCATE(EL%CAV21%PSI);EL%CAV21%PSI=0.0_dp
1115	ALLOCATE(EL%CAV21%DVDS);EL%CAV21%DVDS=0.0_dp
1116	ALLOCATE(EL%CAV21%DPHAS);EL%CAV21%DPHAS=0.0_dp
1117	ALLOCATE(EL%CAV21%cavity_totalpath);EL%CAV21%cavity_totalpath=cavity_totalpath
1118	ALLOCATE(EL%CAV21%phase0);EL%CAV21%phase0=phase0
1119	CASE(KIND22)
1120	if(.not.ASSOCIATED(EL%HE22)) THEN
1121	ALLOCATE(EL%HE22)
1122	el%HE22=0
1123	ELSE
1124	el%HE22=-1
1125	el%HE22=0
1126	ENDIF
1127	EL%HE22%P=>EL%P
1128	EL%HE22%L=>EL%L
1129	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1130	EL%HE22%AN=>EL%AN
1131	EL%HE22%BN=>EL%BN
1132	EL%HE22%FREQ=>EL%FREQ
1133	EL%HE22%PHAS=>EL%PHAS
1134	CASE(KIND5)
1135	if(.not.ASSOCIATED(EL%S5))ALLOCATE(EL%S5)
1136	EL%S5%P=>EL%P
1137	EL%S5%L=>EL%L
1138	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1139	EL%S5%AN=>EL%AN
1140	EL%S5%BN=>EL%BN
1141	EL%S5%FINT=>EL%FINT ! added may 31st 2004
1142	EL%S5%HGAP=>EL%HGAP
1143	EL%S5%H1=>EL%H1
1144	EL%S5%H2=>EL%H2
1145	EL%S5%VA=>EL%VA
1146	EL%S5%VS=>EL%VS
1147	EL%S5%B_SOL=>EL%B_SOL
1148	CASE(KIND6)
1149	IF(EL%P%EXACT.AND.EL%P%B0/=0.0_dp) THEN
1150	w_p=0
1151	w_p%nc=2
1152	w_p%fc='((1X,A72,/,1X,A72))'
1153	w_p%c(1)=" ERROR IN SETFAMILYR "
1154	write(w_p%c(2),'(A37,1x,I4)') " EXACT OPTION NOT SUPPORTED FOR KIND ", EL%KIND
1155	! call !write_e(777)
1156	ENDIF
1157	if(.not.ASSOCIATED(EL%T6)) THEN
1158	ALLOCATE(EL%T6)
1159	el%T6=0
1160	ELSE
1161	el%T6=-1
1162	el%T6=0
1163	ENDIF
1164	EL%T6%P=>EL%P
1165	EL%T6%L=>EL%L
1166	IF(EL%P%NMUL==0) THEN
1167	w_p=0
1168	w_p%nc=2
1169	w_p%fc='((1X,A72,/,1X,A72))'
1170	w_p%c(1)= " ERROR IN SETFAMILYR "
1171	w_p%c(2)= " ERROR ON T6: SLOW THICK "
1172	! call !write_e(0)
1173	ENDIF
1174	EL%T6%AN=>EL%AN
1175	EL%T6%BN=>EL%BN
1176	EL%T6%FINT=>EL%FINT
1177	EL%T6%HGAP=>EL%HGAP
1178	EL%T6%H1=>EL%H1
1179	EL%T6%H2=>EL%H2
1180	EL%T6%VA=>EL%VA
1181	EL%T6%VS=>EL%VS
1182	nullify(EL%T6%MATX);ALLOCATE(EL%T6%MATX(2,3));
1183	nullify(EL%T6%MATY);ALLOCATE(EL%T6%MATY(2,3));
1184	nullify(EL%T6%LX);ALLOCATE(EL%T6%LX(6));
1185	nullify(EL%T6%LY);ALLOCATE(EL%T6%LY(3));
1186	CASE(KIND7)
1187	IF(EL%P%EXACT.AND.EL%P%B0/=0.0_dp) THEN
1188	w_p=0
1189	w_p%nc=2
1190	w_p%fc='((1X,A72,/,1X,A72))'
1191	w_p%c(1)=" ERROR IN SETFAMILYR "
1192	write(w_p%c(2),'(A37,1x,I4)') " EXACT OPTION NOT SUPPORTED FOR KIND ", EL%KIND
1193	! call !write_e(777)
1194	ENDIF
1195	! if(.not.ASSOCIATED(EL%T7))ALLOCATE(EL%T7)
1196	if(.not.ASSOCIATED(EL%T7)) THEN
1197	ALLOCATE(EL%T7)
1198	EL%T7=0
1199	ELSE
1200	EL%T7=-1
1201	EL%T7=0
1202	ENDIF
1203	EL%T7%P=>EL%P
1204	EL%T7%L=>EL%L
1205	IF(EL%P%NMUL==0) THEN
1206	w_p=0
1207	w_p%nc=1
1208	w_p%fc='((1X,A72))'
1209	w_p%c(1)= "ERROR ON T7: FAST THICK "
1210	! call !write_e(0)
1211	ENDIF
1212	EL%T7%AN=>EL%AN
1213	EL%T7%BN=>EL%BN
1214	EL%T7%FINT=>EL%FINT
1215	EL%T7%HGAP=>EL%HGAP
1216	EL%T7%H1=>EL%H1
1217	EL%T7%H2=>EL%H2
1218	EL%T7%VA=>EL%VA
1219	EL%T7%VS=>EL%VS
1220	NULLIFY(EL%T7%F);ALLOCATE(EL%T7%F);EL%T7%F=1;
1221	nullify(EL%T7%MATX);ALLOCATE(EL%T7%MATX(2,3));
1222	nullify(EL%T7%MATY);ALLOCATE(EL%T7%MATY(2,3));
1223	nullify(EL%T7%LX);ALLOCATE(EL%T7%LX(3));
1224	nullify(EL%T7%RMATX);ALLOCATE(EL%T7%RMATX(2,3));
1225	nullify(EL%T7%RMATY);ALLOCATE(EL%T7%RMATY(2,3));
1226	nullify(EL%T7%RLX);ALLOCATE(EL%T7%RLX(3));
1227	IF(GEN) call GETMAT7(EL%T7)
1228	CASE(KIND8)
1229	if(.not.ASSOCIATED(EL%S8))ALLOCATE(EL%S8)
1230	EL%S8%P=>EL%P
1231	IF(EL%P%NMUL==0) THEN
1232	w_p=0
1233	w_p%nc=2
1234	w_p%fc='((1X,A72,/,1X,A72))'
1235	w_p%c(1)= " ERROR IN SETFAMILYR "
1236	w_p%c(2)= "ERROR ON S8: NORMAL SMI "
1237	! call !write_e(0)
1238	ENDIF
1239	EL%S8%BN=>EL%BN
1240	CASE(KIND9)
1241	if(.not.ASSOCIATED(EL%S9))ALLOCATE(EL%S9)
1242	EL%S9%P=>EL%P
1243	IF(EL%P%NMUL==0) THEN
1244	w_p=0
1245	w_p%nc=2
1246	w_p%fc='((1X,A72,/,1X,A72))'
1247	w_p%c(1)= " ERROR IN SETFAMILYR "
1248	w_p%c(2)= "ERROR ON S9: SKEW SMI "
1249	! call !write_e(0)
1250	ENDIF
1251	EL%S9%AN=>EL%AN
1252	CASE(KIND10)
1253	IF(.not.EL%P%EXACT) THEN
1254	w_p=0
1255	w_p%nc=2
1256	w_p%fc='((1X,A72,/,1X,A72))'
1257	w_p%c(1)=" ERROR IN SETFAMILYR "
1258	write(w_p%c(2),'(A37,1x,I4)') " EXACT OPTION NOT SUPPORTED FOR KIND ", EL%KIND
1259	! call !write_e(777)
1260	ENDIF
1261	if(.not.ASSOCIATED(EL%TP10)) THEN
1262	ALLOCATE(EL%TP10)
1263	EL%TP10=0
1264	ELSE
1265	EL%TP10=-1
1266	EL%TP10=0
1267	ENDIF
1268	EL%TP10%P=>EL%P
1269	EL%TP10%L=>EL%L
1270	IF(EL%P%NMUL==0.OR.EL%P%NMUL>SECTOR_NMUL_MAX) THEN
1271	w_p=0
1272	w_p%nc=2
1273	w_p%fc='((1X,A72,/,1X,A72))'
1274	w_p%c(1)= " ERROR IN SETFAMILYR "
1275	w_p%c(2)= "ERROR ON TP10: TEAPOT "
1276	! call !write_e(0)
1277	ENDIF
1278	EL%TP10%AN=>EL%AN
1279	EL%TP10%BN=>EL%BN
1280	EL%TP10%FINT=>EL%FINT
1281	EL%TP10%HGAP=>EL%HGAP
1282	EL%TP10%H1=>EL%H1
1283	EL%TP10%H2=>EL%H2
1284
1285	NULLIFY(EL%TP10%BF_X);ALLOCATE(EL%TP10%BF_X(S_B(SECTOR_NMUL)%N_MONO))
1286	NULLIFY(EL%TP10%BF_Y);ALLOCATE(EL%TP10%BF_Y(S_B(SECTOR_NMUL)%N_MONO))
1287	! NULLIFY(EL%TP10%BF_X);ALLOCATE(EL%TP10%BF_X(S_B0%N_MONO))
1288	! NULLIFY(EL%TP10%BF_Y);ALLOCATE(EL%TP10%BF_Y(S_B0%N_MONO))
1289	! NULLIFY(EL%TP10%BF_X);ALLOCATE(EL%TP10%BF_X(S_B(EL%P%NMUL)%N_MONO))
1290	! NULLIFY(EL%TP10%BF_Y);ALLOCATE(EL%TP10%BF_Y(S_B(EL%P%NMUL)%N_MONO))
1291	NULLIFY(EL%TP10%DRIFTKICK);ALLOCATE(EL%TP10%DRIFTKICK);EL%TP10%DRIFTKICK=.true.;
1292	if(EL%ELECTRIC) then
1293	NULLIFY(EL%TP10%E_X);ALLOCATE(EL%TP10%E_X)
1294	NULLIFY(EL%TP10%E_Y);ALLOCATE(EL%TP10%E_Y)
1295	NULLIFY(EL%TP10%PHI);ALLOCATE(EL%TP10%PHI)
1296	NULLIFY(EL%TP10%AE);ALLOCATE(EL%TP10%AE(NO_E))
1297	NULLIFY(EL%TP10%BE);ALLOCATE(EL%TP10%BE(NO_E))
1298	NULLIFY(EL%TP10%AS);ALLOCATE(EL%TP10%AS(NO_E,0:NO_E,0:NO_E))
1299	NULLIFY(EL%TP10%BS);ALLOCATE(EL%TP10%BS(NO_E,0:NO_E,0:NO_E))
1300	EL%TP10%AS=0.0_dp
1301	EL%TP10%BS=0.0_dp
1302	EL%TP10%AE=0.0_dp
1303	EL%TP10%BE=0.0_dp
1304	EL%TP10%E_X=0.0_dp
1305	EL%TP10%E_Y=0.0_dp
1306	EL%TP10%PHI=0.0_dp
1307	call invert_electric_teapot(EL%TP10%AS,EL%TP10%BS)
1308	endif
1309	call GETANBN(EL%TP10)
1310	NULLIFY(EL%TP10%F);ALLOCATE(EL%TP10%F);EL%TP10%F=1;
1311	CASE(KIND11:KIND14)
1312	if(.not.ASSOCIATED(EL%MON14)) THEN
1313	ALLOCATE(EL%MON14)
1314	el%MON14=0
1315	ELSE
1316	el%MON14=-1
1317	el%MON14=0
1318	ENDIF
1319	EL%MON14%P=>EL%P
1320	EL%MON14%L=>EL%L
1321	nullify(EL%MON14%X);ALLOCATE(EL%MON14%X);EL%MON14%X=0.0_dp;
1322	nullify(EL%MON14%Y);ALLOCATE(EL%MON14%Y);EL%MON14%Y=0.0_dp
1323	CASE(KIND15)
1324	if(.not.ASSOCIATED(EL%SEP15))ALLOCATE(EL%SEP15)
1325	EL%SEP15%P=>EL%P
1326	EL%SEP15%L=>EL%L
1327	EL%SEP15%VOLT=>EL%VOLT
1328	EL%SEP15%PHAS=>EL%PHAS
1329	CASE(KIND16,KIND20)
1330	if(.not.ASSOCIATED(EL%K16)) THEN
1331	ALLOCATE(EL%K16)
1332	el%K16=0
1333	ELSE
1334	el%K16=-1
1335	el%K16=0
1336	ENDIF
1337	EL%K16%P=>EL%P
1338	EL%K16%L=>EL%L
1339	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1340	EL%K16%AN=>EL%AN
1341	EL%K16%BN=>EL%BN
1342	EL%K16%FINT=>EL%FINT
1343	EL%K16%HGAP=>EL%HGAP
1344	EL%K16%H1=>EL%H1
1345	EL%K16%H2=>EL%H2
1346	EL%K16%VA=>EL%VA
1347	EL%K16%VS=>EL%VS
1348	NULLIFY(EL%K16%DRIFTKICK);ALLOCATE(EL%K16%DRIFTKICK);EL%K16%DRIFTKICK=.true.;
1349	NULLIFY(EL%K16%LIKEMAD);ALLOCATE(EL%K16%LIKEMAD);EL%K16%LIKEMAD=.false.;
1350	NULLIFY(EL%K16%F);ALLOCATE(EL%K16%F);EL%K16%F=1;
1351	CASE(KIND17)
1352	if(.not.ASSOCIATED(EL%ENGE17)) THEN
1353	ALLOCATE(EL%ENGE17)
1354	el%ENGE17=0
1355	ELSE
1356	el%ENGE17=-1
1357	el%ENGE17=0
1358	ENDIF
1359	EL%ENGE17%P=>EL%P
1360	EL%ENGE17%L=>EL%L
1361	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1362	EL%ENGE17%AN=>EL%AN
1363	EL%ENGE17%BN=>EL%BN
1364	NULLIFY(EL%ENGE17%F);ALLOCATE(EL%ENGE17%F);EL%ENGE17%F=1.0_dp;
1365	NULLIFY(EL%ENGE17%D);ALLOCATE(EL%ENGE17%D);EL%ENGE17%D=1.0_dp;
1366	NULLIFY(EL%ENGE17%A);ALLOCATE(EL%ENGE17%A(0:N_ENGE));EL%ENGE17%A=0.0_dp;
1367	NULLIFY(EL%ENGE17%nbessel);ALLOCATE(EL%ENGE17%nbessel);EL%ENGE17%nbessel=0;
1368	CASE(KIND18)
1369	if(.not.ASSOCIATED(EL%RCOL18)) THEN
1370	ALLOCATE(EL%RCOL18)
1371	EL%RCOL18=0
1372	ELSE
1373	EL%RCOL18=-1
1374	EL%RCOL18=0
1375	ENDIF
1376	EL%RCOL18%P=>EL%P
1377	EL%RCOL18%L=>EL%L
1378	! nullify(EL%RCOL18%A);!ALLOCATE(EL%RCOL18%A);CALL ALLOC(EL%RCOL18%A)
1379	CASE(KIND19)
1380	if(.not.ASSOCIATED(EL%ECOL19)) THEN
1381	ALLOCATE(EL%ECOL19)
1382	EL%ECOL19=0
1383	ELSE
1384	EL%ECOL19=-1
1385	EL%ECOL19=0
1386	ENDIF
1387	EL%ECOL19%P=>EL%P
1388	EL%ECOL19%L=>EL%L
1389	! nullify(EL%ECOL19%A);!ALLOCATE(EL%ECOL19%A);CALL ALLOC(EL%ECOL19%A)
1390	CASE(KINDWIGGLER)
1391	if(.not.ASSOCIATED(EL%WI)) THEN
1392	ALLOCATE(EL%WI)
1393	EL%WI=0
1394	ELSE
1395	EL%WI=-1
1396	EL%WI=0
1397	ENDIF
1398	EL%WI%P=>EL%P
1399	EL%WI%L=>EL%L
1400	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1401	EL%WI%AN=>EL%AN
1402	EL%WI%BN=>EL%BN
1403	CALL POINTERS_SAGAN(EL%WI)
1404	CASE(KINDpa)
1405	if(.not.ASSOCIATED(EL%pa)) THEN
1406	ALLOCATE(EL%pa)
1407	EL%PA=0
1408	ELSE
1409	EL%pa=-1
1410	EL%pa=0
1411	ENDIF
1412	EL%pa%P=>EL%P
1413	EL%pa%L=>EL%L
1414	! IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1415	! EL%mu%AN=>EL%AN
1416	! EL%mu%BN=>EL%BN
1417	CALL POINTERS_pancake(EL%pa,T) !,t_ax,t_ay)
1418	END SELECT
1419	END SUBROUTINE SETFAMILYR
1420
1421
1422	SUBROUTINE SETFAMILYP(EL,T) !,NTOT,ntot_rad,NTOT_REV,ntot_rad_REV,ND2)
1423	! SUBROUTINE SETFAMILYP(EL,T,t_ax,t_ay,NTOT,ntot_rad,NTOT_REV,ntot_rad_REV,ND2)
1424	IMPLICIT NONE
1425	TYPE(ELEMENTP), INTENT(INOUT) ::EL
1426	! INTEGER,OPTIONAL :: NTOT,ntot_rad,NTOT_REV,ntot_rad_REV,ND2
1427	type(tree_element),OPTIONAL :: T(:) !,t_ax(:),t_ay(:)
1428
1429	! EL%P%permfringe=>EL%permfringe
1430	SELECT CASE(EL%KIND)
1431	CASE(KIND1)
1432	if(.not.ASSOCIATED(EL%D0))ALLOCATE(EL%D0)
1433	EL%D0%P=>EL%P
1434	EL%D0%L=>EL%L
1435	CASE(KIND2)
1436	IF(EL%P%EXACT) THEN
1437	w_p=0
1438	w_p%nc=2
1439	w_p%fc='((1X,A72,/,1X,A72))'
1440	w_p%c(1)=" ERROR IN SETFAMILYP "
1441	write(w_p%c(2),'(A37,1x,I4)') " EXACT OPTION NOT SUPPORTED FOR KIND ", EL%KIND
1442	! call !write_e(222)
1443	ENDIF
1444	if(.not.ASSOCIATED(EL%K2)) THEN
1445	ALLOCATE(EL%K2)
1446	EL%K2=0
1447	ELSE
1448	EL%K2=-1
1449	EL%K2=0
1450	ENDIF
1451	! if(.not.ASSOCIATED(EL%K2))ALLOCATE(EL%K2)
1452	EL%K2%P=>EL%P
1453	EL%K2%L=>EL%L
1454	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1455	EL%K2%AN=>EL%AN
1456	EL%K2%BN=>EL%BN
1457	EL%K2%FINT=>EL%FINT
1458	EL%K2%HGAP=>EL%HGAP
1459	EL%K2%H1=>EL%H1
1460	EL%K2%H2=>EL%H2
1461	EL%K2%VA=>EL%VA
1462	EL%K2%VS=>EL%VS
1463	NULLIFY(EL%K2%F);ALLOCATE(EL%K2%F);EL%K2%F=1;
1464	CASE(KIND3)
1465	if(.not.ASSOCIATED(EL%K3)) THEN
1466	ALLOCATE(EL%K3)
1467	el%K3=0
1468	ELSE
1469	el%K3=-1
1470	el%K3=0
1471	ENDIF
1472	EL%K3%P=>EL%P
1473	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1474	EL%K3%AN=>EL%AN
1475	EL%K3%BN=>EL%BN
1476	ALLOCATE(EL%K3%ls);EL%K3%ls=1
1477	ALLOCATE(EL%K3%hf);CALL ALLOC(EL%K3%hf);EL%K3%hf=0.0_dp
1478	ALLOCATE(EL%K3%vf);CALL ALLOC(EL%K3%vf);EL%K3%vf=0.0_dp
1479	ALLOCATE(EL%K3%thin_h_foc);CALL ALLOC(EL%K3%thin_h_foc);EL%K3%thin_h_foc=0.0_dp
1480	ALLOCATE(EL%K3%thin_v_foc);CALL ALLOC(EL%K3%thin_v_foc);EL%K3%thin_v_foc=0.0_dp
1481	ALLOCATE(EL%K3%thin_h_angle);CALL ALLOC(EL%K3%thin_h_angle);EL%K3%thin_h_angle=0.0_dp
1482	ALLOCATE(EL%K3%thin_v_angle);CALL ALLOC(EL%K3%thin_v_angle);EL%K3%thin_v_angle=0.0_dp
1483	ALLOCATE(EL%K3%patch);EL%K3%patch=my_false
1484	EL%K3%B_SOL=>EL%B_SOL
1485	CASE(KIND4)
1486	if(.not.ASSOCIATED(EL%C4)) THEN
1487	ALLOCATE(EL%C4)
1488	el%C4=0
1489	ELSE
1490	el%C4=-1
1491	el%C4=0
1492	ENDIF
1493	EL%C4%P=>EL%P
1494	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1495	EL%C4%AN=>EL%AN
1496	EL%C4%BN=>EL%BN
1497	EL%C4%L=>EL%L
1498	EL%C4%VOLT=>EL%VOLT
1499	EL%C4%FREQ=>EL%FREQ
1500	EL%C4%PHAS=>EL%PHAS
1501	! EL%C4%P0C=>EL%P0C
1502	EL%C4%DELTA_E=>EL%DELTA_E
1503	EL%C4%THIN=>EL%THIN
1504	ALLOCATE(EL%C4%N_BESSEL);EL%C4%N_BESSEL=0
1505	ALLOCATE(EL%C4%cavity_totalpath);EL%C4%cavity_totalpath=cavity_totalpath
1506	ALLOCATE(EL%C4%phase0);EL%C4%phase0=phase0
1507	ALLOCATE(EL%C4%NF);EL%C4%NF=N_CAV4_F
1508	ALLOCATE(EL%C4%F(N_CAV4_F));CALL ALLOC(EL%C4%F,N_CAV4_F);EL%C4%F(1)=1.0_dp;
1509	ALLOCATE(EL%C4%A);CALL ALLOC(EL%C4%A);EL%C4%A=0.0_dp;
1510	ALLOCATE(EL%C4%R);CALL ALLOC(EL%C4%R);EL%C4%R=1.0_dp;
1511	ALLOCATE(EL%C4%always_on);EL%C4%always_on=my_false;
1512	ALLOCATE(EL%C4%PH(N_CAV4_F));CALL ALLOC(EL%C4%PH,N_CAV4_F);
1513	ALLOCATE(EL%C4%t);EL%C4%t=0.0_dp;
1514	CASE(KIND21)
1515	if(.not.ASSOCIATED(EL%CAV21)) THEN
1516	ALLOCATE(EL%CAV21)
1517	el%CAV21=0
1518	ELSE
1519	el%CAV21=-1
1520	el%CAV21=0
1521	ENDIF
1522	EL%CAV21%P=>EL%P
1523	EL%CAV21%L=>EL%L
1524	EL%CAV21%VOLT=>EL%VOLT
1525	EL%CAV21%FREQ=>EL%FREQ
1526	EL%CAV21%PHAS=>EL%PHAS
1527	! EL%C4%P0C=>EL%P0C
1528	EL%CAV21%DELTA_E=>EL%DELTA_E
1529	EL%CAV21%THIN=>EL%THIN
1530	ALLOCATE(EL%CAV21%PSI);CALL ALLOC(EL%CAV21%PSI);EL%CAV21%PSI=0.0_dp
1531	ALLOCATE(EL%CAV21%DVDS);CALL ALLOC(EL%CAV21%DVDS);EL%CAV21%DVDS=0.0_dp
1532	ALLOCATE(EL%CAV21%DPHAS);CALL ALLOC(EL%CAV21%DPHAS);EL%CAV21%DPHAS=0.0_dp
1533	ALLOCATE(EL%CAV21%cavity_totalpath);EL%CAV21%cavity_totalpath=cavity_totalpath
1534	ALLOCATE(EL%CAV21%phase0);EL%CAV21%phase0=phase0
1535	CASE(KIND22)
1536	if(.not.ASSOCIATED(EL%HE22)) THEN
1537	ALLOCATE(EL%HE22)
1538	el%HE22=0
1539	ELSE
1540	el%HE22=-1
1541	el%HE22=0
1542	ENDIF
1543	EL%HE22%P=>EL%P
1544	EL%HE22%L=>EL%L
1545	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1546	EL%HE22%AN=>EL%AN
1547	EL%HE22%BN=>EL%BN
1548	EL%HE22%FREQ=>EL%FREQ
1549	EL%HE22%PHAS=>EL%PHAS
1550	CASE(KIND5)
1551	if(.not.ASSOCIATED(EL%S5))ALLOCATE(EL%S5)
1552	EL%S5%P=>EL%P
1553	EL%S5%L=>EL%L
1554	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1555	EL%S5%AN=>EL%AN
1556	EL%S5%BN=>EL%BN
1557	EL%S5%FINT=>EL%FINT ! added may 31st 2004
1558	EL%S5%HGAP=>EL%HGAP
1559	EL%S5%H1=>EL%H1
1560	EL%S5%H2=>EL%H2
1561	EL%S5%VA=>EL%VA
1562	EL%S5%VS=>EL%VS
1563	EL%S5%B_SOL=>EL%B_SOL
1564	CASE(KIND6)
1565	IF(EL%P%EXACT.AND.EL%P%B0/=0.0_dp) THEN
1566	w_p=0
1567	w_p%nc=2
1568	w_p%fc='((1X,A72,/,1X,A72))'
1569	w_p%c(1)=" ERROR IN SETFAMILYP "
1570	write(w_p%c(2),'(A37,1x,I4)') " EXACT OPTION NOT SUPPORTED FOR KIND ", EL%KIND
1571	! call !write_e(777)
1572	ENDIF
1573	if(.not.ASSOCIATED(EL%T6)) THEN
1574	ALLOCATE(EL%T6)
1575	el%T6=0
1576	ELSE
1577	el%T6=-1
1578	el%T6=0
1579	ENDIF
1580	EL%T6%P=>EL%P
1581	EL%T6%L=>EL%L
1582	IF(EL%P%NMUL==0) THEN
1583	w_p=0
1584	w_p%nc=2
1585	w_p%fc='((1X,A72,/,1X,A72))'
1586	w_p%c(1)= " ERROR IN SETFAMILYP "
1587	w_p%c(2)= "ERROR ON T6: SLOW THICK "
1588	! call !write_e(0)
1589	ENDIF
1590	EL%T6%AN=>EL%AN
1591	EL%T6%BN=>EL%BN
1592	EL%T6%FINT=>EL%FINT
1593	EL%T6%HGAP=>EL%HGAP
1594	EL%T6%H1=>EL%H1
1595	EL%T6%H2=>EL%H2
1596	EL%T6%VA=>EL%VA
1597	EL%T6%VS=>EL%VS
1598	nullify(EL%T6%MATX);ALLOCATE(EL%T6%MATX(2,3));
1599	nullify(EL%T6%MATY);ALLOCATE(EL%T6%MATY(2,3));
1600	nullify(EL%T6%LX);ALLOCATE(EL%T6%LX(6));
1601	nullify(EL%T6%LY);ALLOCATE(EL%T6%LY(3));
1602	CASE(KIND7)
1603	IF(EL%P%EXACT.AND.EL%P%B0/=0.0_dp) THEN
1604	w_p=0
1605	w_p%nc=2
1606	w_p%fc='((1X,A72,/,1X,A72))'
1607	w_p%c(1)=" ERROR IN SETFAMILYP "
1608	write(w_p%c(2),'(A37,1x,I4)') " EXACT OPTION NOT SUPPORTED FOR KIND ", EL%KIND
1609	! call !write_e(777)
1610	ENDIF
1611	if(.not.ASSOCIATED(EL%T7)) THEN
1612	ALLOCATE(EL%T7)
1613	EL%T7=0
1614	ELSE
1615	EL%T7=-1
1616	EL%T7=0
1617	ENDIF
1618	EL%T7%P=>EL%P
1619	EL%T7%L=>EL%L
1620	IF(EL%P%NMUL==0) THEN
1621	w_p=0
1622	w_p%nc=2
1623	w_p%fc='((1X,A72,/,1X,A72))'
1624	w_p%c(1)= " ERROR IN SETFAMILYP "
1625	w_p%c(2)= "ERROR ON T7: FAST THICK "
1626	! call !write_e(0)
1627	ENDIF
1628	EL%T7%AN=>EL%AN
1629	EL%T7%BN=>EL%BN
1630	EL%T7%FINT=>EL%FINT
1631	EL%T7%HGAP=>EL%HGAP
1632	EL%T7%H1=>EL%H1
1633	EL%T7%H2=>EL%H2
1634	EL%T7%VA=>EL%VA
1635	EL%T7%VS=>EL%VS
1636	NULLIFY(EL%T7%F);ALLOCATE(EL%T7%F);EL%T7%F=1;
1637	nullify(EL%T7%MATX); ALLOCATE(EL%T7%MATX(2,3));
1638	nullify(EL%T7%MATY); ALLOCATE(EL%T7%MATY(2,3));
1639	nullify(EL%T7%LX); ALLOCATE(EL%T7%LX(3));
1640	nullify(EL%T7%RMATX); ALLOCATE(EL%T7%RMATX(2,3));
1641	nullify(EL%T7%RMATY); ALLOCATE(EL%T7%RMATY(2,3));
1642	nullify(EL%T7%RLX); ALLOCATE(EL%T7%RLX(3));
1643	CALL ALLOC(EL%T7)
1644	IF(GEN) call GETMAT7(EL%T7)
1645	CASE(KIND8)
1646	if(.not.ASSOCIATED(EL%S8))ALLOCATE(EL%S8)
1647	EL%S8%P=>EL%P
1648	IF(EL%P%NMUL==0) THEN
1649	w_p=0
1650	w_p%nc=2
1651	w_p%fc='((1X,A72,/,1X,A72))'
1652	w_p%c(1)= " ERROR IN SETFAMILYP "
1653	w_p%c(2)= "ERROR ON S8: NORMAL SMI "
1654	! call !write_e(0)
1655	ENDIF
1656	EL%S8%BN=>EL%BN
1657	CASE(KIND9)
1658	if(.not.ASSOCIATED(EL%S9))ALLOCATE(EL%S9)
1659	EL%S9%P=>EL%P
1660	IF(EL%P%NMUL==0) THEN
1661	w_p=0
1662	w_p%nc=2
1663	w_p%fc='((1X,A72,/,1X,A72))'
1664	w_p%c(1)= " ERROR IN SETFAMILYP "
1665	w_p%c(2)= "ERROR ON S9: SKEW SMI "
1666	! call !write_e(0)
1667	ENDIF
1668	EL%S9%AN=>EL%AN
1669	CASE(KIND10)
1670	IF(.not.EL%P%EXACT) THEN
1671	w_p=0
1672	w_p%nc=2
1673	w_p%fc='((1X,A72,/,1X,A72))'
1674	w_p%c(1)=" ERROR IN SETFAMILYP "
1675	write(w_p%c(2),'(A37,1x,I4)') " EXACT OPTION NOT SUPPORTED FOR KIND ", EL%KIND
1676	! call !write_e(777)
1677	ENDIF
1678	if(.not.ASSOCIATED(EL%TP10)) THEN
1679	ALLOCATE(EL%TP10)
1680	EL%TP10=0
1681	ELSE
1682	EL%TP10=-1
1683	EL%TP10=0
1684	ENDIF
1685	EL%TP10%P=>EL%P
1686	EL%TP10%L=>EL%L
1687	IF(EL%P%NMUL==0.OR.EL%P%NMUL>SECTOR_NMUL_MAX) THEN
1688	w_p=0
1689	w_p%nc=2
1690	w_p%fc='((1X,A72,/,1X,A72))'
1691	w_p%c(1)= " ERROR IN SETFAMILYP "
1692	w_p%c(2)= "ERROR ON TP10: TEAPOT "
1693	! call !write_e(0)
1694	ENDIF
1695	EL%TP10%AN=>EL%AN
1696	EL%TP10%BN=>EL%BN
1697	EL%TP10%FINT=>EL%FINT
1698	EL%TP10%HGAP=>EL%HGAP
1699	EL%TP10%H1=>EL%H1
1700	EL%TP10%H2=>EL%H2
1701	NULLIFY(EL%TP10%BF_X);ALLOCATE(EL%TP10%BF_X(S_B(SECTOR_NMUL)%N_MONO))
1702	NULLIFY(EL%TP10%BF_Y);ALLOCATE(EL%TP10%BF_Y(S_B(SECTOR_NMUL)%N_MONO))
1703	! NULLIFY(EL%TP10%BF_X);ALLOCATE(EL%TP10%BF_X(S_B0%N_MONO))
1704	! NULLIFY(EL%TP10%BF_Y);ALLOCATE(EL%TP10%BF_Y(S_B0%N_MONO))
1705	! NULLIFY(EL%TP10%BF_X);ALLOCATE(EL%TP10%BF_X(S_B(EL%P%NMUL)%N_MONO))
1706	! NULLIFY(EL%TP10%BF_Y);ALLOCATE(EL%TP10%BF_Y(S_B(EL%P%NMUL)%N_MONO))
1707	NULLIFY(EL%TP10%DRIFTKICK);ALLOCATE(EL%TP10%DRIFTKICK);EL%TP10%DRIFTKICK=.true.;
1708	CALL ALLOC(EL%TP10)
1709	if(EL%ELECTRIC) then
1710	NULLIFY(EL%TP10%E_X);ALLOCATE(EL%TP10%E_X)
1711	NULLIFY(EL%TP10%E_Y);ALLOCATE(EL%TP10%E_Y)
1712	NULLIFY(EL%TP10%PHI);ALLOCATE(EL%TP10%PHI)
1713	NULLIFY(EL%TP10%AE);ALLOCATE(EL%TP10%AE(NO_E))
1714	NULLIFY(EL%TP10%BE);ALLOCATE(EL%TP10%BE(NO_E))
1715	call alloc(EL%TP10%E_X,EL%TP10%E_Y,EL%TP10%PHI)
1716	call alloc(EL%TP10%AE,NO_E)
1717	call alloc(EL%TP10%BE,NO_E)
1718	NULLIFY(EL%TP10%AS);ALLOCATE(EL%TP10%AS(NO_E,0:NO_E,0:NO_E))
1719	NULLIFY(EL%TP10%BS);ALLOCATE(EL%TP10%BS(NO_E,0:NO_E,0:NO_E))
1720	EL%TP10%AS=0.0_dp
1721	EL%TP10%BS=0.0_dp
1722	call invert_electric_teapot(EL%TP10%AS,EL%TP10%BS)
1723	! write(6,*) " electric polymorph"
1724	endif
1725	call GETANBN(EL%TP10)
1726	NULLIFY(EL%TP10%F);ALLOCATE(EL%TP10%F);EL%TP10%F=1;
1727	CASE(KIND11:KIND14)
1728	if(.not.ASSOCIATED(EL%MON14)) THEN
1729	ALLOCATE(EL%MON14)
1730	el%MON14=0
1731	ELSE
1732	el%MON14=-1
1733	el%MON14=0
1734	ENDIF
1735	EL%MON14%P=>EL%P
1736	EL%MON14%L=>EL%L
1737	nullify(EL%MON14%X);ALLOCATE(EL%MON14%X);EL%MON14%X=0.0_dp;
1738	nullify(EL%MON14%Y);ALLOCATE(EL%MON14%Y);EL%MON14%Y=0.0_dp
1739	CASE(KIND15)
1740	if(.not.ASSOCIATED(EL%SEP15))ALLOCATE(EL%SEP15)
1741	EL%SEP15%P=>EL%P
1742	EL%SEP15%L=>EL%L
1743	EL%SEP15%VOLT=>EL%VOLT
1744	EL%SEP15%PHAS=>EL%PHAS
1745	CASE(KIND16,KIND20)
1746	if(.not.ASSOCIATED(EL%K16)) THEN
1747	ALLOCATE(EL%K16)
1748	el%K16=0
1749	ELSE
1750	el%K16=-1
1751	el%K16=0
1752	ENDIF
1753	EL%K16%P=>EL%P
1754	EL%K16%L=>EL%L
1755	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1756	EL%K16%AN=>EL%AN
1757	EL%K16%BN=>EL%BN
1758	EL%K16%FINT=>EL%FINT
1759	EL%K16%HGAP=>EL%HGAP
1760	EL%K16%H1=>EL%H1
1761	EL%K16%H2=>EL%H2
1762	EL%K16%VA=>EL%VA
1763	EL%K16%VS=>EL%VS
1764	NULLIFY(EL%K16%DRIFTKICK);ALLOCATE(EL%K16%DRIFTKICK);EL%K16%DRIFTKICK=.true.;
1765	NULLIFY(EL%K16%LIKEMAD);ALLOCATE(EL%K16%LIKEMAD);EL%K16%LIKEMAD=.false.;
1766	NULLIFY(EL%K16%F);ALLOCATE(EL%K16%F);EL%K16%F=1;
1767	CASE(KIND17)
1768	if(.not.ASSOCIATED(EL%ENGE17)) THEN
1769	ALLOCATE(EL%ENGE17)
1770	el%ENGE17=0
1771	ELSE
1772	el%ENGE17=-1
1773	el%ENGE17=0
1774	ENDIF
1775	EL%ENGE17%P=>EL%P
1776	EL%ENGE17%L=>EL%L
1777	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1778	EL%ENGE17%AN=>EL%AN
1779	EL%ENGE17%BN=>EL%BN
1780	NULLIFY(EL%ENGE17%F);ALLOCATE(EL%ENGE17%F);EL%ENGE17%F=1.0_dp;
1781	NULLIFY(EL%ENGE17%D);ALLOCATE(EL%ENGE17%D);EL%ENGE17%D=1.0_dp;
1782	NULLIFY(EL%ENGE17%A);ALLOCATE(EL%ENGE17%A(0:N_ENGE));EL%ENGE17%A=0.0_dp;
1783	NULLIFY(EL%ENGE17%nbessel);ALLOCATE(EL%ENGE17%nbessel);EL%ENGE17%nbessel=0;
1784	CASE(KIND18)
1785	if(.not.ASSOCIATED(EL%RCOL18)) THEN
1786	ALLOCATE(EL%RCOL18)
1787	EL%RCOL18=0
1788	ELSE
1789	EL%RCOL18=-1
1790	EL%RCOL18=0
1791	ENDIF
1792	EL%RCOL18%P=>EL%P
1793	EL%RCOL18%L=>EL%L
1794	! nullify(EL%RCOL18%A);!ALLOCATE(EL%RCOL18%A);CALL ALLOC(EL%RCOL18%A)
1795	CASE(KIND19)
1796	if(.not.ASSOCIATED(EL%ECOL19)) THEN
1797	ALLOCATE(EL%ECOL19)
1798	EL%ECOL19=0
1799	ELSE
1800	EL%ECOL19=-1
1801	EL%ECOL19=0
1802	ENDIF
1803	EL%ECOL19%P=>EL%P
1804	EL%ECOL19%L=>EL%L
1805	! nullify(EL%ECOL19%A);!ALLOCATE(EL%ECOL19%A);CALL ALLOC(EL%ECOL19%A)
1806	! CASE(KIND22)
1807	! if(.not.ASSOCIATED(EL%M22)) THEN
1808	! ALLOCATE(EL%M22)
1809	! el%M22=0
1810	! ELSE
1811	! el%M22=-1
1812	! el%M22=0
1813	! ENDIF
1814	! EL%M22%P=>EL%P
1815	! allocate(EL%M22%DELTAMAP)
1816	! EL%M22%DELTAMAP=.TRUE.
1817	! if(NTOT/=0) then
1818	! allocate(EL%M22%T)
1819	! CALL ALLOC_TREE(EL%M22%T,NTOT,ND2)
1820	! endif
1821	! if(NTOT_rad/=0) then
1822	! allocate(EL%M22%T_rad)
1823	! CALL ALLOC_TREE(EL%M22%T_rad,NTOT_rad,ND2)
1824	! endif
1825	! if(NTOT_REV/=0) then
1826	! allocate(EL%M22%T_REV)
1827	! CALL ALLOC_TREE(EL%M22%T_REV,NTOT_REV,ND2)
1828	! endif
1829	! if(NTOT_rad_REV/=0) then
1830	! allocate(EL%M22%T_rad_REV)
1831	! CALL ALLOC_TREE(EL%M22%T_rad_REV,NTOT_rad_REV,ND2)
1832	! endif
1833	! CASE(KINDUSER1)
1834	! if(.not.ASSOCIATED(EL%U1)) THEN
1835	! ALLOCATE(EL%U1)
1836	! EL%U1=0
1837	! ELSE
1838	! EL%U1=-1
1839	! EL%U1=0
1840	! ENDIF
1841	! EL%U1%P=>EL%P
1842	! EL%U1%L=>EL%L
1843	! IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1844	! EL%U1%AN=>EL%AN
1845	! EL%U1%BN=>EL%BN
1846	! CALL POINTERS_USER1(EL%U1)
1847	! CALL ALLOC(EL%U1)
1848	! CASE(KINDUSER2)
1849	! if(.not.ASSOCIATED(EL%U2)) THEN
1850	! ALLOCATE(EL%U2)
1851	! EL%U2=0
1852	! ELSE
1853	! EL%U2=-1
1854	! EL%U2=0
1855	! ENDIF
1856	! EL%U2%P=>EL%P
1857	! EL%U2%L=>EL%L
1858	! IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1859	! EL%U2%AN=>EL%AN
1860	! EL%U2%BN=>EL%BN
1861	! CALL POINTERS_USER2(EL%U2)
1862	! CALL ALLOC(EL%U2)
1863	CASE(KINDWIGGLER)
1864	if(.not.ASSOCIATED(EL%WI)) THEN
1865	ALLOCATE(EL%WI)
1866	EL%WI=0
1867	ELSE
1868	EL%WI=-1
1869	EL%WI=0
1870	ENDIF
1871	EL%WI%P=>EL%P
1872	EL%WI%L=>EL%L
1873	IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1874	EL%WI%AN=>EL%AN
1875	EL%WI%BN=>EL%BN
1876	CALL POINTERS_SAGAN(EL%WI)
1877	CALL ALLOC(EL%WI)
1878	CASE(KINDpa)
1879	if(.not.ASSOCIATED(EL%pa)) THEN
1880	ALLOCATE(EL%pa)
1881	EL%PA=0
1882	ELSE
1883	EL%pa=-1
1884	EL%pa=0
1885	ENDIF
1886	EL%pa%P=>EL%P
1887	EL%pa%L=>EL%L
1888	! IF(EL%P%NMUL==0) CALL ZERO_ANBN(EL,1)
1889	! EL%mu%AN=>EL%AN
1890	! EL%mu%BN=>EL%BN
1891	CALL POINTERS_pancake(EL%pa,T) !,t_ax,t_ay)
1892	CALL ALLOC(EL%pa%SCALE)
1893	END SELECT
1894
1895	END SUBROUTINE SETFAMILYP
1896
1897
1898
1899	SUBROUTINE ZERO_ANBN_R(EL,N)
1900	IMPLICIT NONE
1901	TYPE(ELEMENT), INTENT(INOUT) ::EL
1902	INTEGER, INTENT(IN) ::N
1903	INTEGER I
1904
1905	IF(N<=0) RETURN
1906	IF(ASSOCIATED(EL%AN)) DEALLOCATE(EL%AN)
1907	IF(ASSOCIATED(EL%BN)) DEALLOCATE(EL%BN)
1908	EL%p%NMUL=N
1909	ALLOCATE(EL%AN(EL%p%NMUL),EL%BN(EL%p%NMUL))
1910
1911	DO I=1,EL%P%NMUL
1912	EL%AN(I)=0.0_dp
1913	EL%BN(I)=0.0_dp
1914	ENDDO
1915
1916	END SUBROUTINE ZERO_ANBN_R
1917
1918	SUBROUTINE ZERO_ANBN_P(EL,N)
1919	IMPLICIT NONE
1920	TYPE(ELEMENTP), INTENT(INOUT) ::EL
1921	INTEGER, INTENT(IN) ::N
1922
1923	IF(N<=0) RETURN
1924	IF(ASSOCIATED(EL%AN)) DEALLOCATE(EL%AN)
1925	IF(ASSOCIATED(EL%BN)) DEALLOCATE(EL%BN)
1926	EL%P%NMUL=N
1927	ALLOCATE(EL%AN(EL%P%NMUL),EL%BN(EL%P%NMUL))
1928	CALL ALLOC(EL%AN,EL%P%NMUL);CALL ALLOC(EL%BN,EL%P%NMUL);
1929
1930	END SUBROUTINE ZERO_ANBN_P
1931
1932	SUBROUTINE transfer_ANBN(EL,ELP,VR,DVR,VP,DVP)
1933	IMPLICIT NONE
1934	TYPE(ELEMENT),TARGET, INTENT(INOUT) ::EL
1935	TYPE(ELEMENTp),TARGET, INTENT(INOUT) ::ELp
1936	real(dp),OPTIONAL :: VR
1937	real(dp),OPTIONAL :: DVR
1938	TYPE(REAL_8),OPTIONAL :: VP
1939	TYPE(REAL_8),OPTIONAL :: DVP
1940	INTEGER N
1941
1942	if(EL%KIND==kind1) return
1943
1944	if(associated(EL%ramp)) then
1945	do n=1,EL%P%NMUL
1946	EL%BN(N)= EL%ramp%table(0)%bn(n)
1947	EL%AN(N)= EL%ramp%table(0)%an(n)
1948	ELP%BN(N)= ELP%ramp%table(0)%bn(n)
1949	ELP%AN(N)= ELP%ramp%table(0)%an(n)
1950	enddo
1951
1952	if(EL%ramp%table(0)%b_t/=0.0_dp) then
1953	if(EL%parent_fibre%PATCH%TIME==0) EL%parent_fibre%PATCH%TIME=2
1954	if(EL%parent_fibre%PATCH%TIME==1) EL%parent_fibre%PATCH%TIME=3
1955	EL%parent_fibre%PATCH%b_T=EL%ramp%table(0)%b_t
1956	else
1957	if(EL%parent_fibre%PATCH%TIME==2) EL%parent_fibre%PATCH%TIME=0
1958	if(EL%parent_fibre%PATCH%TIME==3) EL%parent_fibre%PATCH%TIME=1
1959	EL%parent_fibre%PATCH%b_T=0.0_dp
1960	endif
1961
1962	else
1963
1964	IF(EL%P%NMUL>=1) THEN
1965	if(present(VR))then
1966	do n=1,EL%P%NMUL
1967	EL%BN(N)= vREL%D0_BN(N)+DVREL%D_BN(N)
1968	EL%AN(N)= vREL%D0_AN(N)+DVREL%D_AN(N)
1969	ELP%BN(N)= vREL%D0_BN(N)+DVREL%D_BN(N)
1970	ELP%AN(N)= vREL%D0_AN(N)+DVREL%D_AN(N)
1971	enddo
1972	else
1973	do n=1,EL%P%NMUL
1974	EL%BN(N)= vpEL%D0_BN(N)+DVpEL%D_BN(N)
1975	EL%AN(N)= vpEL%D0_AN(N)+DVpEL%D_AN(N)
1976	ELP%BN(N)= vpEL%D0_BN(N)+DVpEL%D_BN(N)
1977	ELP%AN(N)= vpEL%D0_AN(N)+DVpEL%D_AN(N)
1978	enddo
1979	endif
1980
1981
1982	endif
1983	endif
1984	if(el%kind==kind10) then
1985	call GETANBN(EL%TP10)
1986	call GETANBN(ELP%TP10)
1987	endif
1988	if(el%kind==kind7) then
1989	call GETMAT7(EL%T7)
1990	call GETMAT7(ELP%T7)
1991	endif
1992
1993	END SUBROUTINE transfer_ANBN
1994
1995	SUBROUTINE restore_ANBN(R)
1996	IMPLICIT NONE
1997	type(layout), target :: R
1998	type(fibre), pointer :: P
1999	INTEGER N
2000
2001
2002	p=>r%start
2003
2004	do N=1,R%N
2005	IF(P%MAG%SLOW_AC) THEN
2006	CALL restore_ANBN_SINGLE(P%MAG,P%MAGP)
2007	ELSE
2008	CYCLE
2009	ENDIF
2010	P=>P%NEXT
2011	ENDDO
2012
2013	END SUBROUTINE restore_ANBN
2014
2015	SUBROUTINE restore_ANBN_SINGLE(EL,ELP)
2016	IMPLICIT NONE
2017	TYPE(ELEMENT),TARGET, INTENT(INOUT) ::EL
2018	TYPE(ELEMENTp),TARGET, INTENT(INOUT) ::ELp
2019	INTEGER N
2020
2021	IF(EL%P%NMUL>=1) THEN
2022	do n=1,EL%P%NMUL
2023	if(restore_mag) then
2024	EL%BN(N)= EL%D0_BN(N)
2025	EL%AN(N)= EL%D0_AN(N)
2026	endif
2027	if(restore_magp) then
2028	ELp%BN(N)= EL%D0_BN(N)
2029	ELp%AN(N)= EL%D0_AN(N)
2030	endif
2031	enddo
2032	if(el%kind==kind10) then
2033	if(restore_mag)call GETANBN(EL%TP10)
2034	if(restore_magp)call GETANBN(ELp%TP10)
2035	endif
2036	if(el%kind==kind7) then
2037	if(restore_mag) call GETMAT7(EL%T7)
2038	if(restore_magp) call GETMAT7(ELp%T7)
2039	endif
2040	ENDIF
2041
2042	END SUBROUTINE restore_ANBN_SINGLE
2043
2044	SUBROUTINE force_restore_ANBN_SINGLE(EL,ELP)
2045	IMPLICIT NONE
2046	TYPE(ELEMENT),TARGET, INTENT(INOUT) ::EL
2047	TYPE(ELEMENTp),TARGET, INTENT(INOUT) ::ELp
2048	logical(lp) rm,rmp
2049
2050	rm=restore_mag
2051	rmp=restore_magp
2052	restore_mag=my_true
2053	restore_magp=my_true
2054
2055	call restore_ANBN_SINGLE(EL,ELP)
2056
2057	restore_mag=rm
2058	restore_magp=rmp
2059
2060	END SUBROUTINE force_restore_ANBN_SINGLE
2061
2062	SUBROUTINE force_restore_ANBN(R)
2063	IMPLICIT NONE
2064	type(layout), target :: R
2065	type(fibre), pointer :: P
2066	INTEGER N
2067
2068
2069	p=>r%start
2070
2071	do N=1,R%N
2072	IF(P%MAG%SLOW_AC) CALL force_restore_ANBN_SINGLE(P%MAG,P%MAGP)
2073	P=>P%NEXT
2074	ENDDO
2075
2076	END SUBROUTINE force_restore_ANBN
2077
2078
2079	SUBROUTINE ADDR_ANBN(EL,NM,F,V)
2080	IMPLICIT NONE
2081	TYPE(ELEMENT), INTENT(INOUT) ::EL
2082	real(dp), INTENT(IN) ::V
2083	INTEGER, INTENT(IN) ::NM,F
2084	INTEGER I,N
2085	real(dp), ALLOCATABLE,dimension(:)::AN,BN
2086	if(EL%KIND==kind1) return
2087	N=NM
2088	IF(NM<0) N=-N
2089	! ALREADY THERE
2090	IF(EL%P%NMUL>=N) THEN
2091	IF(NM>0) THEN
2092	EL%BN(N)= F*EL%BN(N)+V
2093	ELSE
2094	EL%AN(N)= F*EL%AN(N)+V
2095	ENDIF
2096	if(el%kind==kind10) then
2097	call GETANBN(EL%TP10)
2098	endif
2099	if(el%kind==kind7) then
2100	call GETMAT7(EL%T7)
2101	endif
2102	RETURN
2103	ENDIF
2104
2105	allocate(AN(N),BN(N))
2106	DO I=1,EL%P%NMUL
2107	AN(I)=EL%AN(I)
2108	BN(I)=EL%BN(I)
2109	ENDDO
2110	DO I=EL%P%NMUL+1,N
2111	AN(I)=0.0_dp
2112	BN(I)=0.0_dp
2113	ENDDO
2114	IF(NM<0) THEN
2115	AN(N)=V
2116	ELSE
2117	BN(N)=V
2118	ENDIF
2119
2120
2121	IF(ASSOCIATED(EL%AN)) DEALLOCATE(EL%AN)
2122	IF(ASSOCIATED(EL%BN)) DEALLOCATE(EL%BN)
2123	EL%P%NMUL=N
2124	ALLOCATE(EL%AN(EL%P%NMUL),EL%BN(EL%P%NMUL))
2125
2126	DO I=1,EL%P%NMUL
2127	EL%AN(I)=AN(I)
2128	EL%BN(I)=BN(I)
2129	ENDDO
2130
2131	DEALLOCATE(AN);DEALLOCATE(BN);
2132
2133	SELECT CASE(EL%KIND)
2134	! CASE(KIND2,KIND3,KIND5,KIND6,KIND17)
2135	! select case(EL%KIND)
2136	case(kind2)
2137	EL%K2%AN=>EL%AN
2138	EL%K2%BN=>EL%BN
2139	case(kind3)
2140	EL%K3%AN=>EL%AN
2141	EL%K3%BN=>EL%BN
2142	case(kind4)
2143	EL%C4%AN=>EL%AN
2144	EL%C4%BN=>EL%BN
2145	case(kind5)
2146	EL%S5%AN=>EL%AN
2147	EL%S5%BN=>EL%BN
2148	case(kind6)
2149	EL%T6%AN=>EL%AN
2150	EL%T6%BN=>EL%BN
2151	CASE(KIND7)
2152	EL%T7%AN=>EL%AN
2153	EL%T7%BN=>EL%BN
2154	call GETMAT7(EL%T7)
2155	CASE(KIND8)
2156	EL%S8%BN=>EL%BN
2157	CASE(KIND9)
2158	EL%S9%AN=>EL%AN
2159	CASE(KIND10)
2160	EL%TP10%AN=>EL%AN
2161	EL%TP10%BN=>EL%BN
2162	call GETANBN(EL%TP10)
2163	CASE(KIND16,KIND20)
2164	EL%K16%AN=>EL%AN
2165	EL%K16%BN=>EL%BN
2166	! CASE(KINDuser1)
2167	! EL%U1%AN=>EL%AN
2168	! EL%U1%BN=>EL%BN
2169	! CASE(KINDuser2)
2170	! EL%U2%AN=>EL%AN
2171	! EL%U2%BN=>EL%BN
2172	CASE(kind17)
2173	EL%ENGE17%AN=>EL%AN
2174	EL%ENGE17%BN=>EL%BN
2175	CASE(KINDWIGGLER)
2176	EL%WI%AN=>EL%AN
2177	EL%WI%BN=>EL%BN
2178	case(kind22)
2179	EL%HE22%AN=>EL%AN
2180	EL%HE22%BN=>EL%BN
2181	case default
2182	w_p=0
2183	w_p%nc=1
2184	w_p%fc='((1X,A72,/,1X,A72))'
2185	write(w_p%c(1),'(A13,A24,A27)')" THIS MAGNET ", MYTYPE(EL%KIND), " CANNOT ACCEPT ANs AND BNs "
2186	! call !write_e(988)
2187	END SELECT
2188
2189
2190	! if(el%kind==kind10) then
2191	! call GETANBN(EL%TP10)
2192	! endif
2193	! if(el%kind==kind7) then
2194	! call GETMAT7(EL%T7)
2195	! endif
2196
2197	END SUBROUTINE ADDR_ANBN
2198
2199	SUBROUTINE ADDP_ANBN(EL,NM,F,V)
2200	IMPLICIT NONE
2201	TYPE(ELEMENTP), INTENT(INOUT) ::EL
2202	real(dp), INTENT(IN) ::V
2203	INTEGER, INTENT(IN) ::NM,F
2204	INTEGER I,N
2205	TYPE(REAL_8), ALLOCATABLE,dimension(:)::AN,BN
2206	if(EL%KIND==kind1) return
2207
2208	N=NM
2209	IF(NM<0) N=-N
2210	! ALREADY THERE
2211	IF(EL%P%NMUL>=N) THEN
2212	IF(NM>0) THEN
2213	EL%BN(N)= F*EL%BN(N)+V
2214	ELSE
2215	EL%AN(N)= F*EL%AN(N)+V
2216	ENDIF
2217	if(el%kind==kind10) then
2218	call GETANBN(EL%TP10)
2219	endif
2220	if(el%kind==kind7) then
2221	call GETMAT7(EL%T7) !etienne
2222	endif
2223	RETURN
2224	ENDIF
2225
2226	allocate(AN(N),BN(N))
2227	CALL ALLOC(AN,N);CALL ALLOC(BN,N);
2228	DO I=1,EL%P%NMUL
2229	AN(I)=EL%AN(I)
2230	BN(I)=EL%BN(I)
2231	ENDDO
2232	IF(NM<0) THEN
2233	AN(N)=V
2234	ELSE
2235	BN(N)=V
2236	ENDIF
2237
2238	CALL KILL(EL%AN,EL%P%NMUL);CALL KILL(EL%BN,EL%P%NMUL);
2239	IF(ASSOCIATED(EL%AN)) DEALLOCATE(EL%AN)
2240	IF(ASSOCIATED(EL%BN)) DEALLOCATE(EL%BN)
2241	EL%P%NMUL=N
2242	ALLOCATE(EL%AN(EL%P%NMUL),EL%BN(EL%P%NMUL))
2243	CALL ALLOC(EL%AN,EL%P%NMUL);CALL ALLOC(EL%BN,EL%P%NMUL); ! BUG there
2244
2245	DO I=1,EL%P%NMUL
2246	EL%AN(I)=AN(I)
2247	EL%BN(I)=BN(I)
2248	ENDDO
2249
2250	DEALLOCATE(AN);DEALLOCATE(BN);
2251
2252	SELECT CASE(EL%KIND)
2253	! CASE(KIND2,KIND3,KIND5,KIND6,KIND17)
2254	! select case(EL%KIND)
2255	case(kind2)
2256	EL%K2%AN=>EL%AN
2257	EL%K2%BN=>EL%BN
2258	case(kind3)
2259	EL%K3%AN=>EL%AN
2260	EL%K3%BN=>EL%BN
2261	case(kind4)
2262	EL%C4%AN=>EL%AN
2263	EL%C4%BN=>EL%BN
2264	case(kind5)
2265	EL%S5%AN=>EL%AN
2266	EL%S5%BN=>EL%BN
2267	case(kind6)
2268	EL%T6%AN=>EL%AN
2269	EL%T6%BN=>EL%BN
2270	CASE(KIND7)
2271	EL%T7%AN=>EL%AN
2272	EL%T7%BN=>EL%BN
2273	call GETMAT7(EL%T7)
2274	CASE(KIND8)
2275	EL%S8%BN=>EL%BN
2276	CASE(KIND9)
2277	EL%S9%AN=>EL%AN
2278	CASE(KIND10)
2279	EL%TP10%AN=>EL%AN
2280	EL%TP10%BN=>EL%BN
2281	call GETANBN(EL%TP10)
2282	CASE(KIND16,KIND20)
2283	EL%K16%AN=>EL%AN
2284	EL%K16%BN=>EL%BN
2285	! CASE(KINDuser1)
2286	! EL%U1%AN=>EL%AN
2287	! EL%U1%BN=>EL%BN
2288	! CASE(KINDuser2)
2289	! EL%U2%AN=>EL%AN
2290	! EL%U2%BN=>EL%BN
2291	CASE(kind17)
2292	EL%ENGE17%AN=>EL%AN
2293	EL%ENGE17%BN=>EL%BN
2294	case(kind22)
2295	EL%HE22%AN=>EL%AN
2296	EL%HE22%BN=>EL%BN
2297	CASE(KINDWIGGLER)
2298	EL%WI%AN=>EL%AN
2299	EL%WI%BN=>EL%BN
2300	case default
2301	w_p=0
2302	w_p%nc=1
2303	w_p%fc='((1X,A72,/,1X,A72))'
2304	write(w_p%c(1),'(A13,A24,A27)')" THIS MAGNET ", MYTYPE(EL%KIND), " CANNOT ACCEPT ANs AND BNs "
2305	! call !write_e(987)
2306	END SELECT
2307
2308	!if(el%kind==kind10) then
2309	!call GETANBN(EL%TP10)
2310	!endif
2311	!if(el%kind==kind7) then
2312	! call GETMAT7(EL%T7)
2313	!endif
2314
2315	END SUBROUTINE ADDP_ANBN
2316
2317
2318
2319	SUBROUTINE null_EL(EL)
2320	IMPLICIT NONE
2321	TYPE(ELEMENT), INTENT(INOUT)::EL
2322	nullify(EL%KIND);
2323	nullify(EL%PLOT);
2324	nullify(EL%NAME);nullify(EL%vorname);nullify(EL%electric);
2325
2326	! nullify(EL%PERMFRINGE);
2327	nullify(EL%L);
2328	nullify(EL%AN);nullify(EL%BN);
2329	nullify(EL%FINT);nullify(EL%HGAP);
2330	nullify(EL%H1);nullify(EL%H2);
2331	nullify(EL%VA);nullify(EL%VS);
2332	nullify(EL%VOLT);nullify(EL%FREQ);nullify(EL%PHAS);nullify(EL%DELTA_E);
2333	nullify(EL%lag);
2334	nullify(EL%B_SOL);
2335	nullify(EL%slow_ac);
2336	nullify(EL%a_ac);
2337	nullify(EL%theta_ac);
2338	nullify(EL%DC_ac);
2339	nullify(EL%D_AC);nullify(EL%D_AN);nullify(EL%D_BN);nullify(EL%D0_AN);nullify(EL%D0_BN);
2340	nullify(EL%THIN);
2341	nullify(EL%MIS); !nullify(EL%EXACTMIS);
2342	! nullify(EL%D);nullify(EL%R);
2343	nullify(EL%D0);
2344	nullify(EL%K2);
2345	nullify(EL%K16);
2346	nullify(EL%K3);
2347	nullify(EL%C4);
2348	nullify(EL%CAV21);
2349	nullify(EL%HE22);
2350	nullify(EL%S5);
2351	nullify(EL%T6);
2352	! nullify(EL%M22);
2353	nullify(EL%T7);
2354	nullify(EL%S8);
2355	nullify(EL%S9);
2356	nullify(EL%TP10);
2357	nullify(EL%MON14);
2358	nullify(EL%SEP15);
2359	nullify(EL%RCOL18);
2360	nullify(EL%ECOL19);
2361	! nullify(EL%U1);
2362	! nullify(EL%U2);
2363	nullify(EL%WI);
2364	nullify(EL%RAMP);
2365	nullify(EL%PA);
2366	nullify(EL%P);
2367	nullify(EL%siamese);
2368	nullify(EL%girders);
2369	nullify(EL%assembly);
2370	nullify(EL%SIAMESE_FRAME);
2371	nullify(EL%girder_FRAME);
2372	nullify(EL%doko);
2373	end SUBROUTINE null_EL
2374
2375	SUBROUTINE null_ELp(EL)
2376	IMPLICIT NONE
2377	TYPE(ELEMENTP), INTENT(INOUT)::EL
2378
2379	nullify(EL%KNOB);
2380	nullify(EL%KIND);
2381	nullify(EL%NAME);nullify(EL%vorname);nullify(EL%electric);
2382
2383	! nullify(EL%PERMFRINGE);
2384	nullify(EL%L);
2385	nullify(EL%AN);nullify(EL%BN);
2386	nullify(EL%FINT);nullify(EL%HGAP);
2387	nullify(EL%H1);nullify(EL%H2);
2388	nullify(EL%VA);nullify(EL%VS);
2389	nullify(EL%VOLT);nullify(EL%FREQ);nullify(EL%PHAS);nullify(EL%DELTA_E);
2390	nullify(EL%B_SOL);
2391	nullify(EL%slow_ac);
2392	nullify(EL%a_ac);
2393	nullify(EL%theta_ac);
2394	nullify(EL%DC_ac);
2395	nullify(EL%D_AC);nullify(EL%D_AN);nullify(EL%D_BN);nullify(EL%D0_AN);nullify(EL%D0_BN);
2396	nullify(EL%THIN);
2397	nullify(EL%MIS); !nullify(EL%EXACTMIS);
2398	! nullify(EL%D);nullify(EL%R);
2399	nullify(EL%D0);
2400	nullify(EL%K2);
2401	nullify(EL%K16);
2402	nullify(EL%K3);
2403	nullify(EL%C4);
2404	nullify(EL%CAV21);
2405	nullify(EL%HE22);
2406	nullify(EL%S5);
2407	nullify(EL%T6);
2408	! nullify(EL%M22);
2409	nullify(EL%T7);
2410	nullify(EL%S8);
2411	nullify(EL%S9);
2412	nullify(EL%TP10);
2413	nullify(EL%MON14);
2414	nullify(EL%SEP15);
2415	nullify(EL%RCOL18);
2416	nullify(EL%ECOL19);
2417	! nullify(EL%U1);
2418	! nullify(EL%U2);
2419	nullify(EL%WI);
2420	nullify(EL%RAMP);
2421	nullify(EL%PA);
2422	nullify(EL%P);
2423	nullify(EL%PARENT_FIBRE);
2424	end SUBROUTINE null_ELp
2425
2426
2427
2428	SUBROUTINE ZERO_EL(EL,I)
2429	IMPLICIT NONE
2430	TYPE(ELEMENT),target, INTENT(INOUT)::EL
2431	INTEGER, INTENT(IN)::I
2432
2433	IF(I==-1) THEN
2434	DEALLOCATE(EL%KIND);
2435	DEALLOCATE(EL%PLOT);
2436	DEALLOCATE(EL%recut);
2437	DEALLOCATE(EL%even);
2438	DEALLOCATE(EL%NAME);DEALLOCATE(EL%VORNAME);DEALLOCATE(EL%electric);
2439	DEALLOCATE(EL%L);
2440	DEALLOCATE(EL%MIS); !DEALLOCATE(EL%EXACTMIS);
2441	call kill(EL%P) ! AIMIN MS 4.0
2442	! DEALLOCATE(EL%PERMFRINGE);
2443	! IF(ASSOCIATED(EL%R)) DEALLOCATE(EL%R)
2444	! IF(ASSOCIATED(EL%D)) DEALLOCATE(EL%D)
2445	IF(ASSOCIATED(EL%AN)) DEALLOCATE(EL%AN)
2446	IF(ASSOCIATED(EL%BN)) DEALLOCATE(EL%BN)
2447	IF(ASSOCIATED(EL%FINT)) DEALLOCATE(EL%FINT)
2448	IF(ASSOCIATED(EL%HGAP)) DEALLOCATE(EL%HGAP)
2449	IF(ASSOCIATED(EL%H1)) DEALLOCATE(EL%H1)
2450	IF(ASSOCIATED(EL%H2)) DEALLOCATE(EL%H2)
2451	IF(ASSOCIATED(EL%VA)) DEALLOCATE(EL%VA)
2452	IF(ASSOCIATED(EL%VS)) DEALLOCATE(EL%VS)
2453	IF(ASSOCIATED(EL%VOLT)) DEALLOCATE(EL%VOLT)
2454	IF(ASSOCIATED(EL%lag)) DEALLOCATE(EL%lag)
2455	IF(ASSOCIATED(EL%FREQ)) DEALLOCATE(EL%FREQ)
2456	IF(ASSOCIATED(EL%PHAS)) DEALLOCATE(EL%PHAS)
2457	IF(ASSOCIATED(EL%DELTA_E)) DEALLOCATE(EL%DELTA_E)
2458	IF(ASSOCIATED(EL%B_SOL)) DEALLOCATE(EL%B_SOL)
2459	IF(ASSOCIATED(EL%slow_ac)) DEALLOCATE(EL%slow_ac)
2460	IF(ASSOCIATED(EL%a_ac)) DEALLOCATE(EL%a_ac)
2461	IF(ASSOCIATED(EL%theta_ac)) DEALLOCATE(EL%theta_ac)
2462	IF(ASSOCIATED(EL%DC_ac)) DEALLOCATE(EL%DC_ac)
2463	IF(ASSOCIATED(EL%D_AC)) DEALLOCATE(EL%D_AC)
2464	IF(ASSOCIATED(EL%D_AN)) DEALLOCATE(EL%D_AN)
2465	IF(ASSOCIATED(EL%D_BN)) DEALLOCATE(EL%D_BN)
2466	IF(ASSOCIATED(EL%D0_AN)) DEALLOCATE(EL%D0_AN)
2467	IF(ASSOCIATED(EL%D0_BN)) DEALLOCATE(EL%D0_BN)
2468	IF(ASSOCIATED(EL%THIN)) DEALLOCATE(EL%THIN)
2469	IF(ASSOCIATED(EL%d0)) DEALLOCATE(EL%d0) ! drift
2470	IF(ASSOCIATED(EL%K2)) DEALLOCATE(EL%K2) ! INTEGRATOR
2471	! IF(ASSOCIATED(EL%K16)) DEALLOCATE(EL%K16) ! INTEGRATOR
2472	! IF(ASSOCIATED(EL%K3)) DEALLOCATE(EL%K3) ! THIN LENS
2473	IF(ASSOCIATED(EL%K3)) then
2474	! IF(ASSOCIATED(EL%K3%hf)) DEALLOCATE(EL%K3%hf)
2475	! IF(ASSOCIATED(EL%K3%vf)) DEALLOCATE(EL%K3%vf)
2476	! IF(ASSOCIATED(EL%K3%thin_h_foc)) DEALLOCATE(EL%K3%thin_h_foc)
2477	! IF(ASSOCIATED(EL%K3%thin_v_foc)) DEALLOCATE(EL%K3%thin_v_foc)
2478	! IF(ASSOCIATED(EL%K3%thin_h_angle)) DEALLOCATE(EL%K3%thin_h_angle)
2479	! IF(ASSOCIATED(EL%K3%thin_v_angle)) DEALLOCATE(EL%K3%thin_v_angle)
2480	! IF(ASSOCIATED(EL%K3%patch)) DEALLOCATE(EL%K3%patch)
2481	EL%K3=-1
2482	DEALLOCATE(EL%K3)
2483	endif
2484
2485	IF(ASSOCIATED(EL%S5)) DEALLOCATE(EL%S5) ! SOLENOID
2486	! IF(ASSOCIATED(EL%T6)) DEALLOCATE(EL%T6) ! INTEGRATOR
2487	! IF(ASSOCIATED(EL%T7)) DEALLOCATE(EL%T7) ! INTEGRATOR
2488	IF(ASSOCIATED(EL%S8)) DEALLOCATE(EL%S8) ! NORMAL SMI
2489	IF(ASSOCIATED(EL%S9)) DEALLOCATE(EL%S9) ! SKEW SMI
2490	! IF(ASSOCIATED(EL%TP10)) DEALLOCATE(EL%TP10) ! SECTOR TEAPOT
2491	IF(ASSOCIATED(EL%T6)) THEN
2492	EL%T6=-1
2493	DEALLOCATE(EL%T6) ! thick sixtrack
2494	ENDIF
2495	! IF(ASSOCIATED(EL%M22)) THEN
2496	! EL%M22=-1
2497	! DEALLOCATE(EL%M22) ! thick sixtrack
2498	! ENDIF
2499	IF(ASSOCIATED(EL%T7)) THEN
2500	EL%T7=-1
2501	DEALLOCATE(EL%T7) ! thick
2502	ENDIF
2503	IF(ASSOCIATED(EL%C4)) THEN
2504	EL%C4=-1
2505	DEALLOCATE(EL%C4) ! MONITOR
2506	ENDIF
2507	IF(ASSOCIATED(EL%CAV21)) THEN
2508	EL%CAV21=-1
2509	DEALLOCATE(EL%CAV21) ! MONITOR
2510	ENDIF
2511	IF(ASSOCIATED(EL%HE22)) THEN
2512	EL%HE22=-1
2513	DEALLOCATE(EL%HE22) ! MONITOR
2514	ENDIF
2515	IF(ASSOCIATED(EL%TP10)) then
2516	EL%TP10=-1
2517	DEALLOCATE(EL%TP10) ! SECTOR TEAPOT
2518	ENDIF
2519	IF(ASSOCIATED(EL%MON14)) THEN
2520	EL%MON14=-1
2521	DEALLOCATE(EL%MON14) ! MONITOR
2522	ENDIF
2523	IF(ASSOCIATED(EL%RCOL18)) THEN
2524	EL%RCOL18=-1
2525	DEALLOCATE(EL%RCOL18) ! RCOLLIMATOR
2526	ENDIF
2527	IF(ASSOCIATED(EL%ECOL19)) THEN
2528	EL%ECOL19=-1
2529	DEALLOCATE(EL%ECOL19) ! ECOLLIMATOR
2530	ENDIF
2531	IF(ASSOCIATED(EL%SEP15)) DEALLOCATE(EL%SEP15) ! ELSEPARATOR
2532	IF(ASSOCIATED(EL%K16)) then
2533	EL%K16=-1
2534	DEALLOCATE(EL%K16) ! INTEGRATOR
2535	endif
2536	! IF(ASSOCIATED(EL%U1)) then
2537	! el%U1=-1 !USER DEFINED MAGNET
2538	! DEALLOCATE(EL%U1)
2539	! ENDIF
2540
2541	! IF(ASSOCIATED(EL%U2)) then
2542	! el%U2=-1 !USER DEFINED MAGNET
2543	! DEALLOCATE(EL%U2)
2544	! ENDIF
2545
2546	IF(ASSOCIATED(EL%WI)) then
2547	el%WI=-1 !USER DEFINED MAGNET
2548	DEALLOCATE(EL%WI)
2549	ENDIF
2550
2551	IF(ASSOCIATED(EL%ramp)) then
2552	el%ramp=-1 !USER DEFINED MAGNET
2553	DEALLOCATE(EL%ramp)
2554	ENDIF
2555
2556	IF(ASSOCIATED(EL%PARENT_FIBRE)) then
2557	nullify(EL%PARENT_FIBRE)
2558	ENDIF
2559	IF(ASSOCIATED(EL%DOKO)) then
2560	nullify(EL%DOKO)
2561	ENDIF
2562	nullify(EL%siamese);
2563	nullify(EL%girders);
2564	IF(ASSOCIATED(EL%SIAMESE_FRAME)) then
2565	call kill_af(EL%SIAMESE_FRAME)
2566	DEALLOCATE(EL%SIAMESE_FRAME)
2567	ENDIF
2568	IF(ASSOCIATED(EL%girder_FRAME)) then
2569	call kill_af(EL%girder_FRAME)
2570	DEALLOCATE(EL%girder_FRAME)
2571	ENDIF
2572
2573
2574	elseif(I>=0) then
2575
2576	!FIRST nullifies
2577
2578	call null_ELEment(el)
2579
2580	call alloc(el%P);
2581
2582	ALLOCATE(EL%KIND);EL%KIND=0;
2583	ALLOCATE(EL%PLOT);EL%PLOT=MY_TRUE;
2584	ALLOCATE(EL%RECUT);EL%RECUT=MY_TRUE;
2585	ALLOCATE(EL%even);EL%even=MY_false;
2586	ALLOCATE(EL%NAME);ALLOCATE(EL%VORNAME);ALLOCATE(EL%electric);
2587	EL%NAME=' ';EL%NAME=TRIM(ADJUSTL(EL%NAME));
2588	EL%VORNAME=' ';EL%VORNAME=TRIM(ADJUSTL(EL%VORNAME));
2589	EL%electric=solve_electric
2590	! ALLOCATE(EL%PERMFRINGE);EL%PERMFRINGE=.FALSE.; ! PART OF A STATE INITIALIZED BY EL=DEFAULT
2591	ALLOCATE(EL%L);EL%L=0.0_dp;
2592	ALLOCATE(EL%MIS);
2593	! ALLOCATE(EL%girder_index);
2594	! ALLOCATE(EL%EXACTMIS);
2595	EL%MIS=.FALSE.;
2596	! EL%EXACTMIS=ALWAYS_EXACTMIS;
2597	! allocate(el%r(3));allocate(el%d(3));
2598	! el%r=zero;el%d=zero;
2599
2600	! EL=DEFAULT;
2601	! ANBN
2602	CALL ZERO_ANBN(EL,I)
2603	ALLOCATE(EL%FINT);EL%FINT=0.5_dp;
2604	ALLOCATE(EL%HGAP);EL%HGAP=0.0_dp;
2605	ALLOCATE(EL%H1);EL%H1=0.0_dp;
2606	ALLOCATE(EL%H2);EL%H2=0.0_dp;
2607	ALLOCATE(EL%VA);EL%VA=0.0_dp;
2608	ALLOCATE(EL%VS);EL%VS=0.0_dp;
2609	! ALLOCATE(EL%theta_ac); EL%theta_ac= zero ;
2610	! ALLOCATE(EL%a_ac); EL%a_ac = zero;
2611	! ALLOCATE(EL%DC_ac); EL%DC_ac= zero ;
2612	ALLOCATE(EL%slow_ac); EL%slow_ac=.false. ;
2613	ENDIF
2614
2615	END SUBROUTINE ZERO_EL
2616
2617	SUBROUTINE ZERO_ELP(EL,I)
2618	IMPLICIT NONE
2619	TYPE(ELEMENTP),target, INTENT(INOUT)::EL
2620	INTEGER, INTENT(IN)::I
2621	INTEGER J
2622
2623	IF(I==-1) THEN
2624
2625	IF(ASSOCIATED(EL%P%NMUL))THEN
2626	IF(EL%P%NMUL>0) THEN
2627	DO J=1,EL%P%NMUL
2628	CALL KILL(EL%AN(J))
2629	CALL KILL(EL%BN(J))
2630	ENDDO
2631	IF(ASSOCIATED(EL%AN)) DEALLOCATE(EL%AN)
2632	IF(ASSOCIATED(EL%BN)) DEALLOCATE(EL%BN)
2633	ENDIF
2634	ENDIF
2635
2636	IF(ASSOCIATED(EL%d0)) DEALLOCATE(EL%d0) ! drift
2637	IF(ASSOCIATED(EL%K2)) DEALLOCATE(EL%K2) ! INTEGRATOR
2638	! IF(ASSOCIATED(EL%K16)) DEALLOCATE(EL%K16) ! INTEGRATOR
2639	! IF(ASSOCIATED(EL%K3)) DEALLOCATE(EL%K3) ! THIN LENS
2640	IF(ASSOCIATED(EL%K3)) then
2641	EL%K3=-1
2642	DEALLOCATE(EL%K3)
2643	! IF(ASSOCIATED(EL%K3%hf)) DEALLOCATE(EL%K3%hf)
2644	! IF(ASSOCIATED(EL%K3%vf)) DEALLOCATE(EL%K3%vf)
2645	! IF(ASSOCIATED(EL%K3%thin_h_foc)) DEALLOCATE(EL%K3%thin_h_foc)
2646	! IF(ASSOCIATED(EL%K3%thin_v_foc)) DEALLOCATE(EL%K3%thin_v_foc)
2647	! IF(ASSOCIATED(EL%K3%thin_h_angle)) DEALLOCATE(EL%K3%thin_h_angle)
2648	! IF(ASSOCIATED(EL%K3%thin_v_angle)) DEALLOCATE(EL%K3%thin_v_angle)
2649	! IF(ASSOCIATED(EL%K3%patch)) DEALLOCATE(EL%K3%patch)
2650	endif
2651
2652	IF(ASSOCIATED(EL%C4)) THEN
2653	EL%C4=-1
2654	DEALLOCATE(EL%C4) ! CAVITY
2655	CALL KILL(EL%VOLT)
2656	CALL KILL(EL%FREQ)
2657	CALL KILL(EL%PHAS)
2658	IF(ASSOCIATED(EL%VOLT)) DEALLOCATE(EL%VOLT)
2659	IF(ASSOCIATED(EL%FREQ)) DEALLOCATE(EL%FREQ)
2660	IF(ASSOCIATED(EL%PHAS)) DEALLOCATE(EL%PHAS)
2661	IF(ASSOCIATED(EL%DELTA_E)) DEALLOCATE(EL%DELTA_E)
2662	IF(ASSOCIATED(EL%THIN)) DEALLOCATE(EL%THIN)
2663	ENDIF
2664	IF(ASSOCIATED(EL%CAV21)) THEN
2665	EL%CAV21=-1
2666	DEALLOCATE(EL%CAV21) ! CAVITY
2667	CALL KILL(EL%VOLT)
2668	CALL KILL(EL%FREQ)
2669	CALL KILL(EL%PHAS)
2670	IF(ASSOCIATED(EL%VOLT)) DEALLOCATE(EL%VOLT)
2671	IF(ASSOCIATED(EL%FREQ)) DEALLOCATE(EL%FREQ)
2672	IF(ASSOCIATED(EL%PHAS)) DEALLOCATE(EL%PHAS)
2673	IF(ASSOCIATED(EL%DELTA_E)) DEALLOCATE(EL%DELTA_E)
2674	IF(ASSOCIATED(EL%THIN)) DEALLOCATE(EL%THIN)
2675	ENDIF
2676
2677	IF(ASSOCIATED(EL%HE22)) THEN
2678	EL%HE22=-1
2679	DEALLOCATE(EL%HE22) ! CAVITY
2680	CALL KILL(EL%FREQ)
2681	CALL KILL(EL%PHAS)
2682	IF(ASSOCIATED(EL%FREQ)) DEALLOCATE(EL%FREQ)
2683	IF(ASSOCIATED(EL%PHAS)) DEALLOCATE(EL%PHAS)
2684	ENDIF
2685
2686	IF(ASSOCIATED(EL%S5)) THEN
2687	DEALLOCATE(EL%S5) ! solenoid
2688	! CALL KILL(EL%B_SOL) ! sagan
2689	! IF(ASSOCIATED(EL%B_SOL)) DEALLOCATE(EL%B_SOL) ! sagan
2690	ENDIF
2691	IF(ASSOCIATED(EL%T6)) then
2692	EL%T6=-1
2693	DEALLOCATE(EL%T6) ! INTEGRATOR
2694	endif
2695	! IF(ASSOCIATED(EL%M22)) then
2696	! EL%M22=-1
2697	! DEALLOCATE(EL%M22) ! INTEGRATOR
2698	! endif
2699	IF(ASSOCIATED(EL%T7)) then
2700	EL%T7=-1
2701	DEALLOCATE(EL%T7) ! INTEGRATOR
2702	ENDIF
2703	IF(ASSOCIATED(EL%S8)) DEALLOCATE(EL%S8) ! SMI KICK
2704	IF(ASSOCIATED(EL%S9)) DEALLOCATE(EL%S9) ! SKEW SMI KICK
2705	IF(ASSOCIATED(EL%MON14)) THEN
2706	EL%MON14=-1
2707	DEALLOCATE(EL%MON14) ! MONITOR
2708	ENDIF
2709	IF(ASSOCIATED(EL%RCOL18)) THEN
2710	EL%RCOL18=-1
2711	DEALLOCATE(EL%RCOL18) ! RCOLLIMATOR
2712	ENDIF
2713	IF(ASSOCIATED(EL%ECOL19)) THEN
2714	EL%ECOL19=-1
2715	DEALLOCATE(EL%ECOL19) ! ECOLLIMATOR
2716	ENDIF
2717	IF(ASSOCIATED(EL%K16)) then
2718	EL%K16=-1
2719	DEALLOCATE(EL%K16) ! INTEGRATOR
2720	endif
2721	IF(ASSOCIATED(EL%SEP15)) THEN
2722	DEALLOCATE(EL%SEP15) ! CAVITY
2723	CALL KILL(EL%VOLT); CALL KILL(EL%PHAS);
2724	IF(ASSOCIATED(EL%VOLT)) DEALLOCATE(EL%VOLT)
2725	IF(ASSOCIATED(EL%PHAS)) DEALLOCATE(EL%PHAS)
2726	ENDIF
2727	IF(ASSOCIATED(EL%TP10)) then
2728	EL%TP10=-1
2729	DEALLOCATE(EL%TP10) ! INTEGRATOR SECTOR EXACT
2730	ENDIF
2731	! IF(ASSOCIATED(EL%U1)) then
2732	! el%U1=-1
2733	! DEALLOCATE(EL%U1)
2734	! ENDIF
2735	! IF(ASSOCIATED(EL%U2)) then
2736	! el%U2=-1
2737	! DEALLOCATE(EL%U2)
2738	! ENDIF
2739
2740	IF(ASSOCIATED(EL%PARENT_FIBRE)) then
2741	nullify(EL%PARENT_FIBRE)
2742	ENDIF
2743	IF(ASSOCIATED(EL%WI)) then
2744	el%WI=-1
2745	DEALLOCATE(EL%WI)
2746	ENDIF
2747
2748
2749	IF(ASSOCIATED(EL%ramp)) then
2750	el%ramp=-1 !USER DEFINED MAGNET
2751	DEALLOCATE(EL%ramp)
2752	ENDIF
2753
2754
2755	! IF(ASSOCIATED(EL%PARENT_FIBRE)) then
2756	! nullify(EL%PARENT_FIBRE)
2757	! ENDIF
2758
2759
2760	DEALLOCATE(EL%KIND);DEALLOCATE(EL%KNOB);
2761	DEALLOCATE(EL%NAME);DEALLOCATE(EL%VORNAME);DEALLOCATE(EL%electric);
2762	! DEALLOCATE(EL%PERMFRINGE);
2763	CALL KILL(EL%L);DEALLOCATE(EL%L);
2764	CALL KILL(EL%FINT);DEALLOCATE(EL%FINT);
2765	CALL KILL(EL%HGAP);DEALLOCATE(EL%HGAP);
2766	CALL KILL(EL%H1);DEALLOCATE(EL%H1);
2767	CALL KILL(EL%H2);DEALLOCATE(EL%H2);
2768	CALL KILL(EL%VA);DEALLOCATE(EL%VA);
2769	CALL KILL(EL%VS);DEALLOCATE(EL%VS);
2770	DEALLOCATE(EL%MIS); !DEALLOCATE(EL%EXACTMIS);
2771
2772	IF(ASSOCIATED(EL%slow_ac))DEALLOCATE(EL%slow_ac)
2773	IF(ASSOCIATED(EL%a_ac)) then
2774	call kill(el%a_ac)
2775	DEALLOCATE(EL%a_ac)
2776	endif
2777	IF(ASSOCIATED(EL%theta_ac)) then
2778	call kill(el%theta_ac)
2779	DEALLOCATE(EL%theta_ac)
2780	endif
2781	IF(ASSOCIATED(EL%DC_ac)) then
2782	call kill(el%DC_ac)
2783	DEALLOCATE(EL%DC_ac)
2784	endif
2785	IF(ASSOCIATED(EL%D_AC)) then
2786	call kill(el%D_AC)
2787	DEALLOCATE(EL%D_AC)
2788	endif
2789	IF(ASSOCIATED(EL%D_AN)) then
2790	call kill(el%D_AN)
2791	DEALLOCATE(EL%D_AN)
2792	endif
2793	IF(ASSOCIATED(EL%D_BN)) then
2794	call kill(el%D_BN)
2795	DEALLOCATE(EL%D_BN)
2796	endif
2797	IF(ASSOCIATED(EL%D0_AN)) then
2798	call kill(el%D0_AN)
2799	DEALLOCATE(EL%D0_AN)
2800	endif
2801	IF(ASSOCIATED(EL%D0_BN)) then
2802	call kill(el%D0_BN)
2803	DEALLOCATE(EL%D0_BN)
2804	endif
2805
2806
2807
2808	call kill(EL%P) ! call kill(EL%P) ! AIMIN MS 4.0
2809
2810	! IF(ASSOCIATED(EL%R)) DEALLOCATE(EL%R)
2811	! IF(ASSOCIATED(EL%D)) DEALLOCATE(EL%D)
2812	! IF(ASSOCIATED(EL%B_SOL)) DEALLOCATE(EL%B_SOL) ! sagan
2813
2814	IF(ASSOCIATED(EL%B_SOL)) then ! sagan
2815	CALL KILL(EL%B_SOL) ! sagan
2816	DEALLOCATE(EL%B_SOL) ! sagan
2817	endif ! sagan
2818
2819	IF(ASSOCIATED(EL%THIN)) DEALLOCATE(EL%THIN)
2820
2821
2822	elseif(I>=0) then
2823
2824	!FIRST nullifies
2825
2826
2827	call null_ELEment(el)
2828
2829	call alloc(el%P)
2830
2831	ALLOCATE(EL%KIND);EL%KIND=0;ALLOCATE(EL%KNOB);EL%KNOB=.FALSE.;
2832	ALLOCATE(EL%NAME);ALLOCATE(EL%VORNAME);ALLOCATE(EL%electric);
2833	EL%NAME=' ';EL%NAME=TRIM(ADJUSTL(EL%NAME));
2834	EL%VORNAME=' ';EL%VORNAME=TRIM(ADJUSTL(EL%VORNAME));
2835	EL%electric=solve_electric
2836	! ALLOCATE(EL%PERMFRINGE);EL%PERMFRINGE=.FALSE.; ! PART OF A STATE INITIALIZED BY EL=DEFAULT
2837	ALLOCATE(EL%L);CALL ALLOC(EL%L);EL%L=0.0_dp;
2838	ALLOCATE(EL%MIS);
2839	! ALLOCATE(EL%EXACTMIS);
2840	EL%MIS=.FALSE.;
2841	! EL%EXACTMIS=ALWAYS_EXACTMIS;
2842	! allocate(el%r(3));allocate(el%d(3));
2843	! el%r=zero;el%d=zero;
2844	! EL=DEFAULT;
2845	! ANBN
2846	CALL ZERO_ANBN(EL,I)
2847	ALLOCATE(EL%FINT);CALL ALLOC(EL%FINT);EL%FINT=0.5_dp;
2848	ALLOCATE(EL%HGAP);CALL ALLOC(EL%HGAP);EL%HGAP=0.0_dp;
2849	ALLOCATE(EL%H1);CALL ALLOC(EL%H1);EL%H1=0.0_dp;
2850	ALLOCATE(EL%H2);CALL ALLOC(EL%H2);EL%H2=0.0_dp;
2851	ALLOCATE(EL%VA);CALL ALLOC(EL%VA);EL%VA=0.0_dp;
2852	ALLOCATE(EL%VS);CALL ALLOC(EL%VS);EL%VS=0.0_dp;
2853	! ALLOCATE(EL%theta_ac);CALL ALLOC(EL%theta_ac); EL%theta_ac= zero ;
2854	! ALLOCATE(EL%a_ac);CALL ALLOC(EL%a_ac); EL%a_ac = zero;
2855	! ALLOCATE(EL%DC_ac); EL%DC_ac= zero ;
2856	ALLOCATE(EL%slow_ac); EL%slow_ac=.false. ;
2857	ENDIF
2858
2859	END SUBROUTINE ZERO_ELP
2860
2861	SUBROUTINE cop_el_elp(EL,ELP)
2862	IMPLICIT NONE
2863	TYPE(ELEMENT),INTENT(IN):: EL
2864	TYPE(ELEMENTP),INTENT(inOUT):: ELP
2865	CALL EQUAL(ELP,EL)
2866	END SUBROUTINE cop_el_elp
2867
2868	SUBROUTINE cop_elp_el(EL,ELP)
2869	IMPLICIT NONE
2870	TYPE(ELEMENTP),INTENT(IN):: EL
2871	TYPE(ELEMENT),INTENT(inOUT):: ELP
2872	CALL EQUAL(ELP,EL)
2873	END SUBROUTINE cop_elp_el
2874
2875	SUBROUTINE cop_el_el(EL,ELP)
2876	IMPLICIT NONE
2877	TYPE(ELEMENT),INTENT(IN):: EL
2878	TYPE(ELEMENT),INTENT(inOUT):: ELP
2879	CALL EQUAL(ELP,EL)
2880	END SUBROUTINE cop_el_el
2881
2882
2883
2884	SUBROUTINE copy_el_elp(ELP,EL)
2885	IMPLICIT NONE
2886	TYPE(ELEMENT),INTENT(IN):: EL
2887	TYPE(ELEMENTP),INTENT(inOUT):: ELP
2888	INTEGER J,i,N
2889
2890	! ELP%PERMFRINGE=EL%PERMFRINGE
2891	ELP%NAME=EL%NAME
2892	ELP%electric=EL%electric
2893	ELP%vorname=EL%vorname
2894	ELP%KIND=EL%KIND
2895	ELP%L=EL%L
2896	ELP%FINT=EL%FINT
2897	ELP%HGAP=EL%HGAP
2898	ELP%H1=EL%H1
2899	ELP%H2=EL%H2
2900	ELP%VA=EL%VA
2901	ELP%VS=EL%VS
2902	! if(associated(el%siamese)) elp%siamese=>el%siamese
2903	! if(associated(el%girder)) elp%girder=>el%girder
2904	ELP%slow_ac=EL%slow_ac
2905
2906	IF(ASSOCIATED(EL%a_ac)) then
2907	ELP%a_ac=EL%a_ac
2908	endif
2909	IF(ASSOCIATED(EL%theta_ac)) then
2910	ELP%theta_ac=EL%theta_ac
2911	endif
2912	IF(ASSOCIATED(EL%DC_ac)) then
2913	ELP%DC_ac=EL%DC_ac
2914	endif
2915
2916
2917
2918	IF(ASSOCIATED(EL%D_AN)) then
2919
2920	IF(EL%P%NMUL>0) THEN
2921	IF(EL%P%NMUL/=ELP%P%NMUL.and.ELP%P%NMUL/=0) THEN
2922	call kill(ELP%D_AN,ELP%P%NMUL);call kill(ELP%D_bN,ELP%P%NMUL);
2923	call kill(ELP%D0_AN,ELP%P%NMUL);call kill(ELP%D0_bN,ELP%P%NMUL);
2924	DEALLOCATE(ELP%D_AN );DEALLOCATE(ELP%D_BN )
2925	DEALLOCATE(ELP%D0_AN );DEALLOCATE(ELP%D0_BN )
2926	endif
2927	if(.not.ASSOCIATED(ELP%D_AN)) THEN
2928	ALLOCATE(ELP%D_AN(EL%P%NMUL),ELP%D_BN(EL%P%NMUL))
2929	ALLOCATE(ELP%D0_AN(EL%P%NMUL),ELP%D0_BN(EL%P%NMUL))
2930	ENDIF
2931
2932
2933	CALL ALLOC(ELP%D_AN,EL%P%NMUL)
2934	CALL ALLOC(ELP%D_BN,EL%P%NMUL)
2935	CALL ALLOC(ELP%D0_AN,EL%P%NMUL)
2936	CALL ALLOC(ELP%D0_BN,EL%P%NMUL)
2937	DO I=1,EL%P%NMUL
2938	ELP%D_AN(I) = EL%D_AN(I)
2939	ELP%D_BN(I) = EL%D_BN(I)
2940	ELP%D0_AN(I) = EL%D0_AN(I)
2941	ELP%D0_BN(I) = EL%D0_BN(I)
2942	ENDDO
2943
2944	ENDIF
2945
2946	endif
2947
2948
2949
2950
2951	IF(EL%P%NMUL>0) THEN
2952	IF(EL%P%NMUL/=ELP%P%NMUL.and.ELP%P%NMUL/=0) THEN
2953	call kill(ELP%AN,ELP%P%NMUL);call kill(ELP%bN,ELP%P%NMUL);
2954	DEALLOCATE(ELP%AN );DEALLOCATE(ELP%BN )
2955	endif
2956	if(.not.ASSOCIATED(ELP%AN)) THEN
2957	ALLOCATE(ELP%AN(EL%P%NMUL),ELP%BN(EL%P%NMUL))
2958	ENDIF
2959
2960
2961	CALL ALLOC(ELP%AN,EL%P%NMUL)
2962	CALL ALLOC(ELP%BN,EL%P%NMUL)
2963	DO I=1,EL%P%NMUL
2964	ELP%AN(I) = EL%AN(I)
2965	ELP%BN(I) = EL%BN(I)
2966	ENDDO
2967
2968	ENDIF
2969	ELP%P=EL%P
2970
2971	! MISALIGNMENTS
2972	ELP%MIS=EL%MIS
2973	! ELP%EXACTMIS=EL%EXACTMIS
2974
2975	! IF(ASSOCIATED(EL%R)) THEN
2976	! if(.not.ASSOCIATED(ELP%R)) ALLOCATE(ELP%R(3))
2977
2978	! DO I=1,3
2979	! ELP%R(I)=EL%R(I)
2980	! ENDDO
2981	! ENDIF
2982	! IF(ASSOCIATED(EL%D)) THEN
2983	! if(.not.ASSOCIATED(ELP%D)) ALLOCATE(ELP%D(3))
2984
2985	! DO I=1,3
2986	! ELP%D(I)=EL%D(I)
2987	! ENDDO
2988	! ENDIF
2989
2990	IF(EL%KIND==KIND1) CALL SETFAMILY(ELP)
2991	IF(EL%KIND==KIND2) then
2992	CALL SETFAMILY(ELP)
2993	ELP%K2%F=EL%K2%F
2994	ENDIF
2995	IF(EL%KIND==KIND16.OR.EL%KIND==KIND20) THEN
2996	CALL SETFAMILY(ELP)
2997	ELP%K16%DRIFTKICK=EL%K16%DRIFTKICK
2998	ELP%K16%LIKEMAD=EL%K16%LIKEMAD
2999	ELP%K16%F=EL%K16%F
3000	ENDIF
3001
3002	IF(EL%KIND==KIND3) THEN
3003	if(.not.ASSOCIATED(ELP%K3)) ALLOCATE(ELP%K3)
3004	ELP%K3=0
3005	if(.not.ASSOCIATED(ELP%B_SOL)) ALLOCATE(ELP%B_SOL )
3006	CALL ALLOC( ELP%B_SOL)
3007	ELP%B_SOL = EL%B_SOL
3008	CALL SETFAMILY(ELP)
3009	ELP%K3%hf=EL%K3%hf
3010	ELP%K3%vf=EL%K3%vf
3011	ELP%K3%thin_h_foc=EL%K3%thin_h_foc
3012	ELP%K3%thin_v_foc=EL%K3%thin_v_foc
3013	ELP%K3%thin_h_angle=EL%K3%thin_h_angle
3014	ELP%K3%thin_v_angle=EL%K3%thin_v_angle
3015	ELP%K3%patch=EL%K3%patch
3016	ELP%K3%ls=EL%K3%ls
3017	ENDIF
3018
3019
3020	IF(EL%KIND==KIND4) THEN !
3021	if(.not.ASSOCIATED(ELP%C4)) ALLOCATE(ELP%C4)
3022	ELP%C4=0
3023	if(.not.ASSOCIATED(ELP%VOLT)) ALLOCATE(ELP%VOLT,ELP%FREQ,ELP%PHAS,ELP%DELTA_E )
3024	if(.not.ASSOCIATED(ELP%THIN)) ALLOCATE(ELP%THIN )
3025	CALL ALLOC( ELP%VOLT)
3026	CALL ALLOC( ELP%FREQ)
3027	CALL ALLOC( ELP%PHAS)
3028	ELP%VOLT = EL%VOLT
3029	ELP%FREQ = EL%FREQ
3030	ELP%PHAS = EL%PHAS
3031	ELP%DELTA_E = EL%DELTA_E ! DELTA_E IS real(dp)
3032	ELP%THIN = EL%THIN
3033	N_CAV4_F=EL%C4%NF
3034	CALL SETFAMILY(ELP)
3035	ELP%C4%N_BESSEL = EL%C4%N_BESSEL
3036	ELP%C4%cavity_totalpath = EL%C4%cavity_totalpath
3037	ELP%C4%phase0 = EL%C4%phase0
3038	DO I=1,EL%C4%NF
3039	ELP%C4%F(I)=EL%C4%F(I)
3040	ELP%C4%PH(I)=EL%C4%PH(I)
3041	ENDDO
3042	ELP%C4%t=EL%C4%t
3043	ELP%C4%R=EL%C4%R
3044	ELP%C4%A=EL%C4%A
3045	ELP%C4%Always_on=EL%C4%Always_on
3046	ENDIF
3047
3048	IF(EL%KIND==KIND21) THEN !
3049	if(.not.ASSOCIATED(ELP%CAV21)) ALLOCATE(ELP%CAV21)
3050	ELP%CAV21=0
3051	if(.not.ASSOCIATED(ELP%VOLT)) ALLOCATE(ELP%VOLT,ELP%FREQ,ELP%PHAS,ELP%DELTA_E )
3052	if(.not.ASSOCIATED(ELP%THIN)) ALLOCATE(ELP%THIN )
3053	CALL ALLOC( ELP%VOLT)
3054	CALL ALLOC( ELP%FREQ)
3055	CALL ALLOC( ELP%PHAS)
3056	ELP%VOLT = EL%VOLT
3057	ELP%FREQ = EL%FREQ
3058	ELP%PHAS = EL%PHAS
3059	ELP%DELTA_E = EL%DELTA_E ! DELTA_E IS real(dp)
3060	ELP%THIN = EL%THIN
3061	CALL SETFAMILY(ELP)
3062	ELP%CAV21%PSI = EL%CAV21%PSI
3063	ELP%CAV21%DVDS = EL%CAV21%DVDS
3064	ELP%CAV21%DPHAS = EL%CAV21%DPHAS
3065	ELP%CAV21%cavity_totalpath = EL%CAV21%cavity_totalpath
3066	ELP%CAV21%phase0 = EL%CAV21%phase0
3067	ENDIF
3068
3069	IF(EL%KIND==KIND22) THEN !
3070	if(.not.ASSOCIATED(ELP%HE22)) ALLOCATE(ELP%HE22)
3071	ELP%HE22=0
3072	if(.not.ASSOCIATED(ELP%FREQ)) ALLOCATE(ELP%FREQ,ELP%PHAS)
3073	CALL ALLOC( ELP%FREQ)
3074	CALL ALLOC( ELP%PHAS)
3075	ELP%FREQ = EL%FREQ
3076	ELP%PHAS = EL%PHAS
3077	CALL SETFAMILY(ELP)
3078	ENDIF
3079
3080	IF(EL%KIND==KIND5) THEN !
3081	if(.not.ASSOCIATED(ELP%B_SOL)) ALLOCATE(ELP%B_SOL )
3082	CALL ALLOC( ELP%B_SOL)
3083	ELP%B_SOL = EL%B_SOL
3084	CALL SETFAMILY(ELP)
3085	ENDIF
3086
3087	! IF(EL%KIND==KIND17) THEN !
3088	! ! if(.not.ASSOCIATED(ELP%S17)) ALLOCATE(ELP%S17)
3089	! if(.not.ASSOCIATED(ELP%B_SOL)) ALLOCATE(ELP%B_SOL )
3090	! CALL ALLOC( ELP%B_SOL) !! * This line added * Sagan
3091	! ELP%B_SOL = EL%B_SOL
3092	! CALL SETFAMILY(ELP)
3093	! ENDIF
3094
3095	IF(EL%KIND==KIND6) CALL SETFAMILY(ELP)
3096
3097	! IF(EL%KIND==KIND22) THEN
3098	! i=0;j=0;k=0;l=0;
3099	! if(associated(EL%M22%T_REV)) i=EL%M22%T_REV%N
3100	! if(associated(EL%M22%T_rad_REV)) j=EL%M22%T_rad_REV%N
3101	! if(associated(EL%M22%T)) k=EL%M22%T%N
3102	! if(associated(EL%M22%T_rad)) l=EL%M22%T_rad%N
3103	! CALL SETFAMILY(ELP,NTOT=k,ntot_rad=l,NTOT_REV=i,ntot_rad_REV=j,ND2=6)
3104	! ELP%M22%DELTAMAP=EL%M22%DELTAMAP
3105	! if(associated(EL%M22%T)) CALL COPY_TREE(EL%M22%T,ELP%M22%T)
3106	! if(associated(EL%M22%T_rad)) CALL COPY_TREE(EL%M22%T_rad,ELP%M22%T_rad)
3107	! if(associated(EL%M22%T_REV)) CALL COPY_TREE(EL%M22%T_REV,ELP%M22%T_REV)
3108	! if(associated(EL%M22%T_rad_REV)) CALL COPY_TREE(EL%M22%T_rad_REV,ELP%M22%T_rad_REV)
3109	! ENDIF
3110
3111	IF(EL%KIND==KIND7) THEN !
3112	GEN=.FALSE.
3113	CALL SETFAMILY(ELP)
3114	IF(.NOT.GEN) THEN !.NOT.GEN
3115	ELP%T7%F=EL%T7%F
3116	DO J=1,3
3117	ELP%T7%LX(J)=EL%T7%LX(J)
3118	ELP%T7%RLX(J)=EL%T7%RLX(J)
3119	DO I=1,2
3120	ELP%T7%MATX(I,J)=EL%T7%MATX(I,J)
3121	ELP%T7%MATY(I,J)=EL%T7%MATY(I,J)
3122	ELP%T7%RMATX(I,J)=EL%T7%RMATX(I,J)
3123	ELP%T7%RMATY(I,J)=EL%T7%RMATY(I,J)
3124	ENDDO
3125	ENDDO
3126	ENDIF !.NOT.GEN
3127	GEN=.TRUE.
3128	ENDIF
3129
3130	IF(EL%KIND==KIND8) CALL SETFAMILY(ELP)
3131
3132	IF(EL%KIND==KIND9) CALL SETFAMILY(ELP)
3133
3134	IF(EL%KIND==KIND10) THEN
3135	CALL SETFAMILY(ELP)
3136	ELP%TP10%DRIFTKICK=EL%TP10%DRIFTKICK
3137	ELP%TP10%F=EL%TP10%F
3138	IF(EL%ELECTRIC) THEN
3139	ELP%TP10%E_X=EL%TP10%E_X
3140	ELP%TP10%E_Y=EL%TP10%E_Y
3141	ELP%TP10%PHI=EL%TP10%PHI
3142	DO I=1,NO_E
3143	ELP%TP10%AE(I)=EL%TP10%AE(I)
3144	ELP%TP10%BE(I)=EL%TP10%BE(I)
3145	enddo
3146	ENDIF
3147	ENDIF
3148
3149	IF(EL%KIND>=KIND11.AND.EL%KIND<=KIND14) THEN
3150	CALL SETFAMILY(ELP)
3151	ELP%MON14%X=EL%MON14%X
3152	ELP%MON14%Y=EL%MON14%Y
3153	ENDIF
3154
3155	IF(EL%KIND==KIND18) THEN
3156	CALL SETFAMILY(ELP)
3157	!ELP%RCOL18%A=EL%RCOL18%A
3158	ENDIF
3159
3160	IF(EL%KIND==KIND19) THEN
3161	CALL SETFAMILY(ELP)
3162	! ELP%ECOL19%A=EL%ECOL19%A
3163	ENDIF
3164
3165	IF(EL%KIND==KIND15) THEN !
3166	if(.not.ASSOCIATED(ELP%VOLT)) ALLOCATE(ELP%VOLT)
3167	if(.not.ASSOCIATED(ELP%PHAS)) ALLOCATE(ELP%PHAS)
3168	CALL ALLOC( ELP%VOLT)
3169	CALL ALLOC( ELP%PHAS)
3170	ELP%VOLT = EL%VOLT
3171	ELP%PHAS = EL%PHAS
3172	CALL SETFAMILY(ELP)
3173	ENDIF
3174
3175	! IF(EL%KIND==KINDUSER1) THEN !
3176	! CALL SETFAMILY(ELP)
3177	! CALL COPY(EL%U1,ELP%U1)
3178	! ENDIF
3179
3180	! IF(EL%KIND==KINDUSER2) THEN !
3181	! CALL SETFAMILY(ELP)
3182	! CALL COPY(EL%U2,ELP%U2)
3183	! ENDIF
3184
3185	IF(EL%KIND==KINDWIGGLER) THEN !
3186	CALL SETFAMILY(ELP)
3187	CALL COPY(EL%WI,ELP%WI)
3188	ENDIF
3189
3190	IF(ASSOCIATED(EL%RAMP)) THEN !
3191	CALL COPY_RAMPING(EL%RAMP,ELP%RAMP)
3192	ENDIF
3193
3194
3195
3196	IF(EL%KIND==KINDPA) THEN !
3197	CALL SETFAMILY(ELP,EL%PA%B) !,EL%PA%ax,EL%PA%ay)
3198	CALL COPY(EL%PA,ELP%PA)
3199	ENDIF
3200	! IF(ASSOCIATED(EL%PARENT_FIBRE)) then
3201	! ELP%PARENT_FIBRE=>EL%PARENT_FIBRE
3202	! ENDIF
3203
3204
3205	END SUBROUTINE copy_el_elp
3206
3207
3208
3209
3210
3211	SUBROUTINE copy_elp_el(ELP,EL)
3212	IMPLICIT NONE
3213	TYPE(ELEMENTP),INTENT(IN):: EL
3214	TYPE(ELEMENT),INTENT(inOUT):: ELP
3215	INTEGER I,J,N
3216
3217	! if(associated(el%siamese)) elp%siamese=>el%siamese
3218	! if(associated(el%girder)) elp%girder=>el%girder
3219	! ELP%PERMFRINGE=EL%PERMFRINGE
3220	ELP%electric=EL%electric
3221	ELP%vorname=EL%vorname
3222	ELP%KIND=EL%KIND
3223	ELP%L=EL%L
3224	ELP%FINT=EL%FINT
3225	ELP%HGAP=EL%HGAP
3226	ELP%H1=EL%H1
3227	ELP%H2=EL%H2
3228	ELP%VA=EL%VA
3229	ELP%VS=EL%VS
3230	ELP%slow_ac=EL%slow_ac
3231
3232	IF(ASSOCIATED(EL%a_ac)) then
3233	ELP%a_ac=EL%a_ac
3234	endif
3235	IF(ASSOCIATED(EL%theta_ac)) then
3236	ELP%theta_ac=EL%theta_ac
3237	endif
3238	IF(ASSOCIATED(EL%DC_ac)) then
3239	ELP%DC_ac=EL%DC_ac
3240	endif
3241
3242
3243	IF(ASSOCIATED(EL%D_AN)) then
3244
3245	IF(EL%P%NMUL>0) THEN
3246	IF(EL%P%NMUL/=ELP%P%NMUL.and.ELP%P%NMUL/=0) THEN
3247	DEALLOCATE(ELP%D_AN );DEALLOCATE(ELP%D_BN )
3248	DEALLOCATE(ELP%D0_AN );DEALLOCATE(ELP%D0_BN )
3249	endif
3250	if(.not.ASSOCIATED(ELP%D_AN)) THEN
3251	ALLOCATE(ELP%D_AN(EL%P%NMUL),ELP%D_BN(EL%P%NMUL))
3252	ALLOCATE(ELP%D0_AN(EL%P%NMUL),ELP%D0_BN(EL%P%NMUL))
3253	ENDIF
3254
3255	DO I=1,EL%P%NMUL
3256	ELP%D_AN(I) = EL%D_AN(I)
3257	ELP%D_BN(I) = EL%D_BN(I)
3258	ELP%D0_AN(I) = EL%D0_AN(I)
3259	ELP%D0_BN(I) = EL%D0_BN(I)
3260	ENDDO
3261
3262	ENDIF
3263
3264	endif
3265
3266
3267
3268
3269
3270	IF(EL%P%NMUL>0) THEN
3271	IF(EL%P%NMUL/=ELP%P%NMUL.and.ELP%P%NMUL/=0) THEN
3272	DEALLOCATE(ELP%AN );DEALLOCATE(ELP%BN )
3273	endif
3274	if(.not.ASSOCIATED(ELP%AN)) THEN
3275	ALLOCATE(ELP%AN(EL%P%NMUL),ELP%BN(EL%P%NMUL))
3276	ENDIF
3277
3278	DO I=1,EL%P%NMUL
3279	ELP%AN(I) = EL%AN(I)
3280	ELP%BN(I) = EL%BN(I)
3281	ENDDO
3282
3283	ENDIF
3284	ELP%P=EL%P
3285
3286
3287
3288	! MISALIGNMENTS
3289	ELP%MIS=EL%MIS
3290	! ELP%EXACTMIS=EL%EXACTMIS
3291
3292	! IF(ASSOCIATED(EL%R)) THEN
3293	! if(.not.ASSOCIATED(ELP%R)) ALLOCATE(ELP%R(3))
3294
3295	! DO I=1,3
3296	! ELP%R(I)=EL%R(I)
3297	! ENDDO
3298	! ENDIF
3299	! IF(ASSOCIATED(EL%D)) THEN
3300	! if(.not.ASSOCIATED(ELP%D)) ALLOCATE(ELP%D(3))
3301
3302	! DO I=1,3
3303	! ELP%D(I)=EL%D(I)
3304	! ENDDO
3305	! ENDIF
3306
3307	IF(EL%KIND==KIND1) CALL SETFAMILY(ELP)
3308
3309	IF(EL%KIND==KIND2) then
3310	CALL SETFAMILY(ELP)
3311	ELP%K2%F=EL%K2%F
3312	ENDIF
3313	IF(EL%KIND==KIND16.OR.EL%KIND==KIND20) THEN
3314	CALL SETFAMILY(ELP)
3315	ELP%K16%DRIFTKICK=EL%K16%DRIFTKICK
3316	ELP%K16%LIKEMAD=EL%K16%LIKEMAD
3317	ELP%K16%F=EL%K16%F
3318	ENDIF
3319
3320	IF(EL%KIND==KIND3) THEN
3321	if(.not.ASSOCIATED(ELP%K3)) ALLOCATE(ELP%K3)
3322	ELP%K3=0
3323	if(.not.ASSOCIATED(ELP%B_SOL)) ALLOCATE(ELP%B_SOL )
3324	ELP%B_SOL = EL%B_SOL
3325	CALL SETFAMILY(ELP)
3326	ELP%K3%hf=EL%K3%hf
3327	ELP%K3%vf=EL%K3%vf
3328	ELP%K3%thin_h_foc=EL%K3%thin_h_foc
3329	ELP%K3%thin_v_foc=EL%K3%thin_v_foc
3330	ELP%K3%thin_h_angle=EL%K3%thin_h_angle
3331	ELP%K3%thin_v_angle=EL%K3%thin_v_angle
3332	ELP%K3%patch=EL%K3%patch
3333	ELP%K3%ls=EL%K3%ls
3334	ENDIF
3335
3336
3337	IF(EL%KIND==KIND4) THEN !
3338	if(.not.ASSOCIATED(ELP%C4)) ALLOCATE(ELP%C4)
3339	ELP%C4=0
3340	if(.not.ASSOCIATED(ELP%VOLT)) ALLOCATE(ELP%VOLT,ELP%FREQ,ELP%PHAS,ELP%DELTA_E )
3341	if(.not.ASSOCIATED(ELP%THIN)) ALLOCATE(ELP%THIN )
3342	ELP%VOLT = EL%VOLT
3343	ELP%FREQ = EL%FREQ
3344	ELP%PHAS = EL%PHAS
3345	ELP%DELTA_E = EL%DELTA_E
3346	ELP%THIN = EL%THIN
3347	N_CAV4_F=EL%C4%NF
3348	CALL SETFAMILY(ELP)
3349	ELP%C4%N_BESSEL = EL%C4%N_BESSEL
3350	ELP%C4%cavity_totalpath = EL%C4%cavity_totalpath
3351	ELP%C4%phase0 = EL%C4%phase0
3352	DO I=1,EL%C4%NF
3353	ELP%C4%F(I)=EL%C4%F(I)
3354	ELP%C4%PH(I)=EL%C4%PH(I)
3355	ENDDO
3356	ELP%C4%t=EL%C4%t
3357	ELP%C4%R=EL%C4%R
3358	ELP%C4%A=EL%C4%A
3359	ELP%C4%Always_on=EL%C4%Always_on
3360	ENDIF
3361
3362	IF(EL%KIND==KIND21) THEN !
3363	if(.not.ASSOCIATED(ELP%CAV21)) ALLOCATE(ELP%CAV21)
3364	ELP%CAV21=0
3365	if(.not.ASSOCIATED(ELP%VOLT)) ALLOCATE(ELP%VOLT,ELP%FREQ,ELP%PHAS,ELP%DELTA_E )
3366	if(.not.ASSOCIATED(ELP%THIN)) ALLOCATE(ELP%THIN )
3367	ELP%VOLT = EL%VOLT
3368	ELP%FREQ = EL%FREQ
3369	ELP%PHAS = EL%PHAS
3370	ELP%DELTA_E = EL%DELTA_E
3371	ELP%THIN = EL%THIN
3372	CALL SETFAMILY(ELP)
3373	ELP%CAV21%PSI = EL%CAV21%PSI
3374	ELP%CAV21%DVDS = EL%CAV21%DVDS
3375	ELP%CAV21%DPHAS = EL%CAV21%DPHAS
3376	ELP%CAV21%cavity_totalpath = EL%CAV21%cavity_totalpath
3377	ELP%CAV21%phase0 = EL%CAV21%phase0
3378	ENDIF
3379
3380	IF(EL%KIND==KIND22) THEN !
3381	if(.not.ASSOCIATED(ELP%HE22)) ALLOCATE(ELP%HE22)
3382	ELP%HE22=0
3383	if(.not.ASSOCIATED(ELP%FREQ)) ALLOCATE(ELP%FREQ,ELP%PHAS)
3384	ELP%FREQ = EL%FREQ
3385	ELP%PHAS = EL%PHAS
3386	CALL SETFAMILY(ELP)
3387	ENDIF
3388
3389	IF(EL%KIND==KIND5) THEN !
3390	if(.not.ASSOCIATED(ELP%S5)) ALLOCATE(ELP%S5)
3391	if(.not.ASSOCIATED(ELP%B_SOL)) ALLOCATE(ELP%B_SOL )
3392	ELP%B_SOL = EL%B_SOL
3393	CALL SETFAMILY(ELP)
3394	ENDIF
3395
3396	! IF(EL%KIND==KIND17) THEN !
3397	! ! if(.not.ASSOCIATED(ELP%S17)) ALLOCATE(ELP%S17)
3398	! if(.not.ASSOCIATED(ELP%B_SOL)) ALLOCATE(ELP%B_SOL )
3399	! ELP%B_SOL = EL%B_SOL
3400	! CALL SETFAMILY(ELP)
3401	! ENDIF
3402
3403	IF(EL%KIND==KIND6) CALL SETFAMILY(ELP)
3404
3405	! IF(EL%KIND==KIND22) THEN
3406	! i=0;j=0;k=0;l=0;
3407	! if(associated(EL%M22%T_REV)) i=EL%M22%T_REV%N
3408	! if(associated(EL%M22%T_rad_REV)) j=EL%M22%T_rad_REV%N
3409	! if(associated(EL%M22%T)) k=EL%M22%T%N
3410	! if(associated(EL%M22%T_rad)) l=EL%M22%T_rad%N
3411	! CALL SETFAMILY(ELP,NTOT=k,ntot_rad=l,NTOT_REV=i,ntot_rad_REV=j,ND2=6)
3412	! ELP%M22%DELTAMAP=EL%M22%DELTAMAP
3413	!
3414	! if(associated(EL%M22%T)) CALL COPY_TREE(EL%M22%T,ELP%M22%T)
3415	! if(associated(EL%M22%T_rad)) CALL COPY_TREE(EL%M22%T_rad,ELP%M22%T_rad)
3416	! if(associated(EL%M22%T_REV)) CALL COPY_TREE(EL%M22%T_REV,ELP%M22%T_REV)
3417	! if(associated(EL%M22%T_rad_REV)) CALL COPY_TREE(EL%M22%T_rad_REV,ELP%M22%T_rad_REV)
3418	! ENDIF
3419
3420	IF(EL%KIND==KIND7) THEN !
3421	GEN=.FALSE.
3422	CALL SETFAMILY(ELP)
3423	IF(.NOT.GEN) THEN !.NOT.GEN
3424	ELP%T7%F=EL%T7%F
3425	DO J=1,3
3426	ELP%T7%LX(J)=EL%T7%LX(J)
3427	ELP%T7%RLX(J)=EL%T7%RLX(J)
3428	DO I=1,2
3429	ELP%T7%MATX(I,J)=EL%T7%MATX(I,J)
3430	ELP%T7%MATY(I,J)=EL%T7%MATY(I,J)
3431	ELP%T7%RMATX(I,J)=EL%T7%RMATX(I,J)
3432	ELP%T7%RMATY(I,J)=EL%T7%RMATY(I,J)
3433	ENDDO
3434	ENDDO
3435	ENDIF !.NOT.GEN
3436	GEN=.TRUE.
3437
3438	ENDIF
3439
3440
3441	IF(EL%KIND==KIND8) CALL SETFAMILY(ELP)
3442
3443	IF(EL%KIND==KIND9) CALL SETFAMILY(ELP)
3444
3445	IF(EL%KIND==KIND10) THEN
3446	CALL SETFAMILY(ELP)
3447	ELP%TP10%DRIFTKICK=EL%TP10%DRIFTKICK
3448	ELP%TP10%F=EL%TP10%F
3449	IF(EL%ELECTRIC) THEN
3450	ELP%TP10%E_X=EL%TP10%E_X
3451	ELP%TP10%E_Y=EL%TP10%E_Y
3452	ELP%TP10%PHI=EL%TP10%PHI
3453	DO I=1,NO_E
3454	ELP%TP10%AE(I)=EL%TP10%AE(I)
3455	ELP%TP10%BE(I)=EL%TP10%BE(I)
3456	enddo
3457	ENDIF
3458
3459	ENDIF
3460
3461	IF(EL%KIND>=KIND11.AND.EL%KIND<=KIND14) THEN
3462	CALL SETFAMILY(ELP)
3463	ELP%MON14%X=EL%MON14%X
3464	ELP%MON14%Y=EL%MON14%Y
3465	ENDIF
3466
3467	IF(EL%KIND==KIND18) THEN
3468	CALL SETFAMILY(ELP)
3469	! ELP%RCOL18%A=EL%RCOL18%A
3470	ENDIF
3471
3472	IF(EL%KIND==KIND19) THEN
3473	CALL SETFAMILY(ELP)
3474	! ELP%ECOL19%A=EL%ECOL19%A
3475	ENDIF
3476
3477	IF(EL%KIND==KIND15) THEN !
3478	if(.not.ASSOCIATED(ELP%SEP15)) ALLOCATE(ELP%SEP15)
3479	if(.not.ASSOCIATED(ELP%VOLT)) ALLOCATE(ELP%VOLT)
3480	if(.not.ASSOCIATED(ELP%PHAS)) ALLOCATE(ELP%PHAS)
3481	ELP%VOLT = EL%VOLT
3482	ELP%PHAS = EL%PHAS
3483	CALL SETFAMILY(ELP)
3484	ENDIF
3485
3486	! IF(EL%KIND==KINDUSER1) THEN !
3487	! CALL SETFAMILY(ELP)
3488	! CALL COPY(EL%U1,ELP%U1)
3489	! ENDIF
3490
3491	! IF(EL%KIND==KINDUSER2) THEN !
3492	! CALL SETFAMILY(ELP)
3493	! CALL COPY(EL%U2,ELP%U2)
3494	! ENDIF
3495
3496	IF(EL%KIND==KINDWIGGLER) THEN !
3497	CALL SETFAMILY(ELP)
3498	CALL COPY(EL%WI,ELP%WI)
3499	ENDIF
3500
3501	IF(ASSOCIATED(EL%RAMP)) THEN !
3502	CALL COPY_RAMPING(EL%RAMP,ELP%RAMP)
3503	ENDIF
3504
3505	IF(EL%KIND==KINDPA) THEN !
3506	CALL SETFAMILY(ELP,EL%PA%B) !,EL%PA%ax,EL%PA%ay)
3507	CALL COPY(EL%PA,ELP%PA)
3508	ENDIF
3509
3510	! IF(ASSOCIATED(EL%PARENT_FIBRE)) then
3511	! ELP%PARENT_FIBRE=>EL%PARENT_FIBRE
3512	! ENDIF
3513
3514
3515	END SUBROUTINE copy_elp_el
3516
3517
3518
3519	SUBROUTINE copy_el_el(ELP,EL)
3520	IMPLICIT NONE
3521	TYPE(ELEMENT),INTENT(IN):: EL
3522	TYPE(ELEMENT),INTENT(inOUT):: ELP
3523	INTEGER I,J,n
3524
3525
3526	! if(associated(el%siamese)) elp%siamese=>el%siamese
3527	! if(associated(el%girder)) elp%girder=>el%girder
3528	! ELP%PERMFRINGE=EL%PERMFRINGE
3529	ELP%NAME=EL%NAME
3530	ELP%electric=EL%electric
3531	ELP%vorname=EL%vorname
3532	ELP%RECUT=EL%RECUT
3533	ELP%even=EL%even
3534	ELP%KIND=EL%KIND
3535	ELP%PLOT=EL%PLOT
3536	ELP%L=EL%L
3537	ELP%FINT=EL%FINT
3538	ELP%HGAP=EL%HGAP
3539	ELP%H1=EL%H1
3540	ELP%H2=EL%H2
3541	ELP%VA=EL%VA
3542	ELP%VS=EL%VS
3543	ELP%slow_ac=EL%slow_ac
3544
3545	IF(ASSOCIATED(EL%a_ac)) then
3546	ELP%a_ac=EL%a_ac
3547	endif
3548	IF(ASSOCIATED(EL%theta_ac)) then
3549	ELP%theta_ac=EL%theta_ac
3550	endif
3551	IF(ASSOCIATED(EL%DC_ac)) then
3552	ELP%DC_ac=EL%DC_ac
3553	endif
3554
3555	IF(ASSOCIATED(EL%D_AN)) then
3556
3557	IF(EL%P%NMUL>0) THEN
3558	IF(EL%P%NMUL/=ELP%P%NMUL.and.ELP%P%NMUL/=0) THEN
3559	DEALLOCATE(ELP%D_AN );DEALLOCATE(ELP%D_BN )
3560	DEALLOCATE(ELP%D0_AN );DEALLOCATE(ELP%D0_BN )
3561	endif
3562	if(.not.ASSOCIATED(ELP%D_AN)) THEN
3563	ALLOCATE(ELP%D_AN(EL%P%NMUL),ELP%D_BN(EL%P%NMUL))
3564	ALLOCATE(ELP%D0_AN(EL%P%NMUL),ELP%D0_BN(EL%P%NMUL))
3565	ENDIF
3566
3567	DO I=1,EL%P%NMUL
3568	ELP%D_AN(I) = EL%D_AN(I)
3569	ELP%D_BN(I) = EL%D_BN(I)
3570	ELP%D0_AN(I) = EL%D0_AN(I)
3571	ELP%D0_BN(I) = EL%D0_BN(I)
3572	ENDDO
3573
3574	ENDIF
3575
3576	endif
3577
3578
3579
3580
3581	IF(EL%P%NMUL>0) THEN
3582	IF(EL%P%NMUL/=ELP%P%NMUL.and.ELP%P%NMUL/=0) THEN
3583	DEALLOCATE(ELP%AN );DEALLOCATE(ELP%BN )
3584	endif
3585	if(.not.ASSOCIATED(ELP%AN)) THEN
3586	ALLOCATE(ELP%AN(EL%P%NMUL),ELP%BN(EL%P%NMUL))
3587	ENDIF
3588
3589	DO I=1,EL%P%NMUL
3590	ELP%AN(I) = EL%AN(I)
3591	ELP%BN(I) = EL%BN(I)
3592	ENDDO
3593
3594	ENDIF
3595	ELP%P=EL%P
3596
3597
3598
3599	! MISALIGNMENTS
3600	ELP%MIS=EL%MIS
3601	! ELP%EXACTMIS=EL%EXACTMIS
3602
3603	! IF(ASSOCIATED(EL%R)) THEN
3604	! if(.not.ASSOCIATED(ELP%R)) ALLOCATE(ELP%R(3))
3605	! DO I=1,3
3606	! ELP%R(I)=EL%R(I)
3607	! ENDDO
3608	! ENDIF
3609	! IF(ASSOCIATED(EL%D)) THEN
3610	! if(.not.ASSOCIATED(ELP%D)) ALLOCATE(ELP%D(3))
3611	! DO I=1,3
3612	! ELP%D(I)=EL%D(I)
3613	! ENDDO
3614	! ENDIF
3615
3616	IF(EL%KIND==KIND1) CALL SETFAMILY(ELP)
3617
3618	IF(EL%KIND==KIND2) then
3619	CALL SETFAMILY(ELP)
3620	ELP%K2%F=EL%K2%F
3621	ENDIF
3622	IF(EL%KIND==KIND16.OR.EL%KIND==KIND20) THEN
3623	CALL SETFAMILY(ELP)
3624	ELP%K16%DRIFTKICK=EL%K16%DRIFTKICK
3625	ELP%K16%LIKEMAD=EL%K16%LIKEMAD
3626	ELP%K16%F=EL%K16%F
3627	ENDIF
3628
3629	IF(EL%KIND==KIND3) THEN
3630	if(.not.ASSOCIATED(ELP%K3)) ALLOCATE(ELP%K3)
3631	ELP%K3=0
3632	if(.not.ASSOCIATED(ELP%B_SOL)) ALLOCATE(ELP%B_SOL )
3633	ELP%B_SOL = EL%B_SOL
3634	CALL SETFAMILY(ELP)
3635	ELP%K3%hf=EL%K3%hf
3636	ELP%K3%vf=EL%K3%vf
3637	ELP%K3%thin_h_foc=EL%K3%thin_h_foc
3638	ELP%K3%thin_v_foc=EL%K3%thin_v_foc
3639	ELP%K3%thin_h_angle=EL%K3%thin_h_angle
3640	ELP%K3%thin_v_angle=EL%K3%thin_v_angle
3641	ELP%K3%patch=EL%K3%patch
3642	ELP%K3%ls=EL%K3%ls
3643	ENDIF
3644
3645
3646	IF(EL%KIND==KIND4) THEN !
3647	if(.not.ASSOCIATED(ELP%C4)) ALLOCATE(ELP%C4)
3648	ELP%C4=0
3649	if(.not.ASSOCIATED(ELP%VOLT)) ALLOCATE(ELP%VOLT,ELP%FREQ,ELP%PHAS,ELP%DELTA_E )
3650	if(.not.ASSOCIATED(ELP%THIN)) ALLOCATE(ELP%THIN )
3651	if(.not.ASSOCIATED(ELP%lag)) ALLOCATE(ELP%lag )
3652	ELP%lag = EL%lag
3653	ELP%VOLT = EL%VOLT
3654	ELP%FREQ = EL%FREQ
3655	ELP%PHAS = EL%PHAS
3656	ELP%DELTA_E = EL%DELTA_E
3657	ELP%THIN = EL%THIN
3658	N_CAV4_F=EL%C4%NF
3659	CALL SETFAMILY(ELP)
3660	ELP%C4%N_BESSEL = EL%C4%N_BESSEL
3661	ELP%C4%cavity_totalpath = EL%C4%cavity_totalpath
3662	ELP%C4%phase0 = EL%C4%phase0
3663	DO I=1,EL%C4%NF
3664	ELP%C4%F(I)=EL%C4%F(I)
3665	ELP%C4%PH(I)=EL%C4%PH(I)
3666	ENDDO
3667	ELP%C4%t=EL%C4%t
3668	ELP%C4%R=EL%C4%R
3669	ELP%C4%A=EL%C4%A
3670	ELP%C4%Always_on=EL%C4%Always_on
3671	ENDIF
3672
3673	IF(EL%KIND==KIND21) THEN !
3674	if(.not.ASSOCIATED(ELP%CAV21)) ALLOCATE(ELP%CAV21)
3675	ELP%CAV21=0
3676	if(.not.ASSOCIATED(ELP%VOLT)) ALLOCATE(ELP%VOLT,ELP%FREQ,ELP%PHAS,ELP%DELTA_E )
3677	if(.not.ASSOCIATED(ELP%THIN)) ALLOCATE(ELP%THIN )
3678	if(.not.ASSOCIATED(ELP%lag)) ALLOCATE(ELP%lag )
3679	ELP%lag = EL%lag
3680	ELP%VOLT = EL%VOLT
3681	ELP%FREQ = EL%FREQ
3682	ELP%PHAS = EL%PHAS
3683	ELP%DELTA_E = EL%DELTA_E
3684	ELP%THIN = EL%THIN
3685	CALL SETFAMILY(ELP)
3686	ELP%CAV21%PSI = EL%CAV21%PSI
3687	ELP%CAV21%DVDS = EL%CAV21%DVDS
3688	ELP%CAV21%DPHAS = EL%CAV21%DPHAS
3689	ELP%CAV21%cavity_totalpath = EL%CAV21%cavity_totalpath
3690	ELP%CAV21%phase0 = EL%CAV21%phase0
3691	ENDIF
3692
3693	IF(EL%KIND==KIND22) THEN !
3694	if(.not.ASSOCIATED(ELP%HE22)) ALLOCATE(ELP%HE22)
3695	ELP%HE22=0
3696	if(.not.ASSOCIATED(ELP%FREQ)) ALLOCATE(ELP%FREQ,ELP%PHAS)
3697	ELP%FREQ = EL%FREQ
3698	ELP%PHAS = EL%PHAS
3699	CALL SETFAMILY(ELP)
3700	ENDIF
3701
3702	IF(EL%KIND==KIND5) THEN !
3703	if(.not.ASSOCIATED(ELP%S5)) ALLOCATE(ELP%S5)
3704	if(.not.ASSOCIATED(ELP%B_SOL)) ALLOCATE(ELP%B_SOL )
3705	ELP%B_SOL = EL%B_SOL
3706	CALL SETFAMILY(ELP)
3707	ENDIF
3708
3709	! IF(EL%KIND==KIND17) THEN !
3710	! ! if(.not.ASSOCIATED(ELP%S17)) ALLOCATE(ELP%S17)
3711	! if(.not.ASSOCIATED(ELP%B_SOL)) ALLOCATE(ELP%B_SOL )
3712	! ELP%B_SOL = EL%B_SOL
3713	! CALL SETFAMILY(ELP)
3714	! ENDIF
3715
3716	IF(EL%KIND==KIND6) CALL SETFAMILY(ELP)
3717
3718	! IF(EL%KIND==KIND22) THEN
3719	! i=0;j=0;k=0;l=0;
3720	! if(associated(EL%M22%T_REV)) i=EL%M22%T_REV%N
3721	! if(associated(EL%M22%T_rad_REV)) j=EL%M22%T_rad_REV%N
3722	! if(associated(EL%M22%T)) k=EL%M22%T%N
3723	! if(associated(EL%M22%T_rad)) l=EL%M22%T_rad%N
3724	! CALL SETFAMILY(ELP,NTOT=k,ntot_rad=l,NTOT_REV=i,ntot_rad_REV=j,ND2=6)
3725	! ELP%M22%DELTAMAP=EL%M22%DELTAMAP
3726	!
3727	! if(associated(EL%M22%T)) CALL COPY_TREE(EL%M22%T,ELP%M22%T)
3728	! if(associated(EL%M22%T_rad)) CALL COPY_TREE(EL%M22%T_rad,ELP%M22%T_rad)
3729	! if(associated(EL%M22%T_REV)) CALL COPY_TREE(EL%M22%T_REV,ELP%M22%T_REV)
3730	! if(associated(EL%M22%T_rad_REV)) CALL COPY_TREE(EL%M22%T_rad_REV,ELP%M22%T_rad_REV)
3731	! ENDIF
3732
3733	IF(EL%KIND==KIND7) THEN !
3734	GEN=.FALSE.
3735	CALL SETFAMILY(ELP)
3736	IF(.NOT.GEN) THEN !.NOT.GEN
3737	ELP%T7%F=EL%T7%F
3738	DO J=1,3
3739	ELP%T7%LX(J)=EL%T7%LX(J)
3740	ELP%T7%RLX(J)=EL%T7%RLX(J)
3741	DO I=1,2
3742	ELP%T7%MATX(I,J)=EL%T7%MATX(I,J)
3743	ELP%T7%MATY(I,J)=EL%T7%MATY(I,J)
3744	ELP%T7%RMATX(I,J)=EL%T7%RMATX(I,J)
3745	ELP%T7%RMATY(I,J)=EL%T7%RMATY(I,J)
3746	ENDDO
3747	ENDDO
3748	ENDIF !.NOT.GEN
3749	GEN=.TRUE.
3750	ENDIF
3751
3752
3753	IF(EL%KIND==KIND8) CALL SETFAMILY(ELP)
3754
3755	IF(EL%KIND==KIND9) CALL SETFAMILY(ELP)
3756
3757	IF(EL%KIND==KIND10) THEN
3758	CALL SETFAMILY(ELP)
3759	ELP%TP10%DRIFTKICK=EL%TP10%DRIFTKICK
3760	ELP%TP10%F=EL%TP10%F
3761	IF(EL%ELECTRIC) THEN
3762	ELP%TP10%E_X=EL%TP10%E_X
3763	ELP%TP10%E_Y=EL%TP10%E_Y
3764	ELP%TP10%PHI=EL%TP10%PHI
3765	DO I=1,NO_E
3766	ELP%TP10%AE(I)=EL%TP10%AE(I)
3767	ELP%TP10%BE(I)=EL%TP10%BE(I)
3768	enddo
3769	ENDIF
3770	ENDIF
3771
3772	IF(EL%KIND>=KIND11.AND.EL%KIND<=KIND14) THEN
3773	CALL SETFAMILY(ELP)
3774	ELP%MON14%X=EL%MON14%X
3775	ELP%MON14%Y=EL%MON14%Y
3776	ENDIF
3777
3778	IF(EL%KIND==KIND18) THEN
3779	CALL SETFAMILY(ELP)
3780	! ELP%RCOL18%A=EL%RCOL18%A
3781	ENDIF
3782
3783	IF(EL%KIND==KIND19) THEN
3784	CALL SETFAMILY(ELP)
3785	! ELP%ECOL19%A=EL%ECOL19%A
3786	ENDIF
3787
3788	IF(EL%KIND==KIND15) THEN !
3789	if(.not.ASSOCIATED(ELP%SEP15)) ALLOCATE(ELP%SEP15)
3790	if(.not.ASSOCIATED(ELP%VOLT)) ALLOCATE(ELP%VOLT)
3791	if(.not.ASSOCIATED(ELP%PHAS)) ALLOCATE(ELP%PHAS)
3792	ELP%VOLT = EL%VOLT
3793	ELP%PHAS = EL%PHAS
3794	CALL SETFAMILY(ELP)
3795	ENDIF
3796
3797	! IF(EL%KIND==KINDUSER1) THEN !
3798	! CALL SETFAMILY(ELP)
3799	! CALL COPY(EL%U1,ELP%U1)
3800	! ENDIF
3801
3802	! IF(EL%KIND==KINDUSER2) THEN !
3803	! CALL SETFAMILY(ELP)
3804	! CALL COPY(EL%U2,ELP%U2)
3805	! ENDIF
3806
3807	IF(EL%KIND==KINDWIGGLER) THEN !
3808	CALL SETFAMILY(ELP)
3809	CALL COPY(EL%WI,ELP%WI)
3810	ENDIF
3811
3812	IF(ASSOCIATED(EL%RAMP)) THEN !
3813	CALL COPY_RAMPING(EL%RAMP,ELP%RAMP)
3814	ENDIF
3815
3816	IF(EL%KIND==KINDPA) THEN !
3817	CALL SETFAMILY(ELP,EL%PA%B) !,EL%PA%ax,EL%PA%ay)
3818	CALL COPY(EL%PA,ELP%PA)
3819	ENDIF
3820
3821	! IF(ASSOCIATED(EL%PARENT_FIBRE)) then
3822	! ELP%PARENT_FIBRE=>EL%PARENT_FIBRE
3823	! ENDIF
3824
3825
3826	END SUBROUTINE copy_el_el
3827
3828
3829	SUBROUTINE reset31(ELP)
3830	IMPLICIT NONE
3831	TYPE(ELEMENTP),INTENT(inOUT):: ELP
3832	INTEGER I
3833
3834	ELP%knob=.FALSE.
3835
3836	CALL resetpoly_R31(ELP%L) ! SHARED BY EVERYONE
3837	CALL resetpoly_R31(ELP%FINT) ! SHARED BY EVERYONE
3838	CALL resetpoly_R31(ELP%HGAP) ! SHARED BY EVERYONE
3839	CALL resetpoly_R31(ELP%H1) ! SHARED BY EVERYONE
3840	CALL resetpoly_R31(ELP%H2) ! SHARED BY EVERYONE
3841	CALL resetpoly_R31(ELP%VA) ! SHARED BY EVERYONE
3842	CALL resetpoly_R31(ELP%VS) ! SHARED BY EVERYONE
3843	if(associated(ELP%theta_ac)) CALL resetpoly_R31(ELP%theta_ac) ! SHARED BY EVERYONE
3844	if(associated(ELP%a_ac)) CALL resetpoly_R31(ELP%a_ac) ! SHARED BY EVERYONE
3845	if(associated(ELP%DC_ac)) CALL resetpoly_R31(ELP%DC_ac) ! SHARED BY EVERYONE
3846	if(associated(ELP%D_ac)) then
3847	CALL resetpoly_R31(ELP%D_ac) ! SHARED BY EVERYONE
3848	IF(ELP%P%NMUL>0) THEN ! SHARED BY A LOT
3849	DO I=1,ELP%P%NMUL
3850	CALL resetpoly_R31(ELP%d_AN(I))
3851	CALL resetpoly_R31(ELP%d_BN(I))
3852	CALL resetpoly_R31(ELP%d0_AN(I))
3853	CALL resetpoly_R31(ELP%d0_BN(I))
3854	ENDDO
3855	ENDIF
3856	endif
3857	IF(ELP%P%NMUL>0) THEN ! SHARED BY A LOT
3858	DO I=1,ELP%P%NMUL
3859	CALL resetpoly_R31(ELP%AN(I))
3860	CALL resetpoly_R31(ELP%BN(I))
3861	ENDDO
3862	ENDIF
3863
3864
3865	IF(ELP%KIND==KIND4) THEN
3866	CALL resetpoly_R31(ELP%VOLT)
3867	CALL resetpoly_R31(ELP%FREQ )
3868	CALL resetpoly_R31(ELP%PHAS )
3869	DO I=1,ELP%C4%NF
3870	CALL resetpoly_R31(ELP%C4%F(I))
3871	CALL resetpoly_R31(ELP%C4%PH(I))
3872	ENDDO
3873	CALL resetpoly_R31(ELP%C4%A )
3874	CALL resetpoly_R31(ELP%C4%R )
3875
3876	! CALL resetpoly_R31(ELP%P0C )
3877	ENDIF
3878
3879	IF(ELP%KIND==KIND3) THEN
3880	CALL resetpoly_R31(ELP%K3%hf)
3881	CALL resetpoly_R31(ELP%K3%vf)
3882	CALL resetpoly_R31(ELP%K3%thin_h_foc)
3883	CALL resetpoly_R31(ELP%K3%thin_v_foc)
3884	CALL resetpoly_R31(ELP%K3%thin_h_angle )
3885	CALL resetpoly_R31(ELP%K3%thin_v_angle)
3886	CALL resetpoly_R31(ELP%B_SOL)
3887	ENDIF
3888
3889	IF(ELP%KIND==KIND21) THEN
3890	CALL resetpoly_R31(ELP%VOLT)
3891	CALL resetpoly_R31(ELP%FREQ )
3892	CALL resetpoly_R31(ELP%PHAS )
3893	CALL resetpoly_R31(ELP%CAV21%PSI )
3894	CALL resetpoly_R31(ELP%CAV21%DVDS )
3895	CALL resetpoly_R31(ELP%CAV21%DPHAS )
3896	ENDIF
3897
3898	IF(ELP%KIND==KIND22) THEN
3899	CALL resetpoly_R31(ELP%FREQ )
3900	CALL resetpoly_R31(ELP%PHAS )
3901	ENDIF
3902
3903	IF(ELP%KIND==KIND15) THEN ! NEW 2002.11.16
3904	CALL resetpoly_R31(ELP%VOLT)
3905	CALL resetpoly_R31(ELP%PHAS )
3906	ENDIF
3907
3908	IF(ELP%KIND==KIND5) THEN
3909	CALL resetpoly_R31(ELP%B_SOL)
3910	ENDIF
3911
3912
3913
3914	! IF(ELP%KIND==KINDUSER1) THEN
3915	! CALL reset_U1(ELP%U1)
3916	! ENDIF
3917
3918	! IF(ELP%KIND==KINDUSER2) THEN
3919	! CALL reset_U2(ELP%U2)
3920	! ENDIF
3921
3922	IF(ELP%KIND==KINDWIGGLER) THEN
3923	CALL reset_WI(ELP%WI)
3924	ENDIF
3925
3926	IF(ELP%KIND==KINDPA) THEN
3927	CALL reset_PA(ELP%PA)
3928	ENDIF
3929
3930
3931	END SUBROUTINE reset31
3932
3933	SUBROUTINE find_energy(t,KINETIC,ENERGY,P0C,BRHO,beta0,gamma)
3934	implicit none
3935	type(work) ,INTENT(INout):: t
3936	real(dp) XMC2,cl,CU,ERG,beta0i,GAMMA0,GAMMA2,CON
3937	logical(lp) PROTON
3938	real(dp) KINETIC1,ENERGY1,P0C1,BRHO1,beta01,gamma1 ! private here
3939	real(dp), optional :: KINETIC,ENERGY,P0C,BRHO,beta0,gamma ! private here
3940	real(dp) gamma0I,gamBET ! private here
3941
3942	gamma1=0.0_dp
3943	kinetic1=0.0_dp
3944	ENERGY1=0.0_dp
3945	beta01=0.0_dp
3946	brho1=0.0_dp
3947	p0c1=0.0_dp
3948	if(present(gamma)) gamma1=-gamma
3949	if(present(KINETIC)) kinetic1=-kinetic
3950	if(present(energy)) energy1=-energy
3951	if(present(BETa0)) BETa01=-BETa0
3952	if(present(brho) ) brho1=-brho
3953	if(present(p0c) ) p0c1=-p0c
3954
3955	PROTON=.NOT.ELECTRON
3956	cl=(clight/1e8_dp)
3957	CU=55.0_dp/24.0_dp/SQRT(3.0_dp)
3958	w_p=0
3959	w_p%nc=8
3960	w_p%fc='(7((1X,A72,/)),1X,A72)'
3961	if(electron) then
3962	XMC2=muon*pmae
3963	w_p%c(1)=" This is an electron "
3964	elseif(proton) then
3965	XMC2=pmap
3966	w_p%c(1)=" This is a proton! "
3967	endif
3968	if(ENERGY1<0) then
3969	ENERGY1=-ENERGY1
3970	erg=ENERGY1
3971	p0c1=SQRT(erg2-xmc22)
3972	endif
3973	if(kinetic1<0) then
3974	kinetic1=-kinetic1
3975	erg=kinetic1+xmc2
3976	p0c1=SQRT(erg2-xmc22)
3977	endif
3978	if(brho1<0) then
3979	brho1=-brho1
3980	p0c1=SQRT(brho1*2(cl/10.0_dp)**2)
3981	endif
3982	if(BETa01<0) then
3983	BETa01=-BETa01
3984	p0c1=xmc2BETa01/SQRT(1.0_dp-BETa01*2)
3985	endif
3986
3987	if(p0c1<0) then
3988	p0c1=-p0c1
3989	endif
3990
3991	if(gamma1<0) then
3992	gamma1=-gamma1
3993	erg=gamma1*xmc2
3994	p0c1=sqrt(erg2-XMC22)
3995	endif
3996
3997	erg=SQRT(p0c12+XMC22)
3998	kinetic1=ERG-xmc2
3999	BETa01=SQRT(kinetic1*2+2.0_dpkinetic1*XMC2)/erg
4000	beta0i=1.0_dp/BETa01
4001	GAMMA0=erg/XMC2
4002	write(W_P%C(2),'(A16,g21.14)') ' Kinetic Energy ',kinetic1
4003	write(W_P%C(3),'(A7,g21.14)') ' gamma ',gamma0
4004	write(W_P%C(4),'(A7,g21.14)')' beta0 ',BETa01
4005	CON=3.0_dpCUCGAMHBC/2.0_dpTWOPII/XMC2**3
4006	CRAD=CGAMTWOPII !ERG**3
4007	CFLUC=CON !ERG*5
4008	GAMMA2=erg2/XMC22
4009	brho1=SQRT(ERG2-XMC22)*10.0_dp/cl
4010	if(verbose) then
4011	write(W_P%C(5),'(A7,g21.14)') ' p0c = ',p0c1
4012	write(W_P%C(6),'(A9,g21.14)')' GAMMA0 = ',SQRT(GAMMA2)
4013	write(W_P%C(7),'(A8,g21.14)')' BRHO = ',brho1
4014	write(W_P%C(8),'(A15,G21.14,1X,g21.14)')"CRAD AND CFLUC ", crad ,CFLUC
4015	endif
4016	! IF(VERBOSE) ! call ! WRITE_I
4017	!END OF SET RADIATION STUFF AND TIME OF FLIGHT SUFF
4018	! gamma0I=SQRT(one-beta0**2)
4019	! gambet =(gamma0I/beta0)**2
4020	gamma0I=XMC2*BETa01/p0c1
4021	GAMBET=(XMC2/p0c1)**2
4022
4023	t%kinetic=kinetic1
4024	t%energy =ERG
4025	t%BETa0=BETa01
4026	t%BRHO=brho1
4027	t%p0c=p0c1
4028	t%gamma0I=gamma0I
4029	t%gambet=gambet
4030	t%mass=xmc2
4031
4032
4033	END SUBROUTINE find_energy
4034
4035	subroutine put_aperture_el(el,kind,r,x,y,dx,dy)
4036	implicit none
4037	real(dp),intent(in):: r(2),x,y,dx,dy
4038	integer,intent(in):: kind
4039	type(element),intent(inout):: el
4040
4041	if(.not.associated(el%p%aperture)) call alloc(el%p%aperture)
4042	el%p%aperture%dx=dx
4043	el%p%aperture%dy=dy
4044	el%p%aperture%x=x
4045	el%p%aperture%y=y
4046	el%p%aperture%r=r
4047	el%p%aperture%kind=kind
4048	end subroutine put_aperture_el
4049
4050	subroutine put_aperture_elp(el,kind,r,x,y,dx,dy)
4051	implicit none
4052	real(dp),intent(in):: r(2),x,y,dx,dy
4053	integer,intent(in):: kind
4054	type(elementp),intent(inout):: el
4055
4056	if(.not.associated(el%p%aperture)) call alloc(el%p%aperture)
4057	el%p%aperture%dx=dx
4058	el%p%aperture%dy=dy
4059	el%p%aperture%x=x
4060	el%p%aperture%y=y
4061	el%p%aperture%r=r
4062	el%p%aperture%kind=kind
4063	end subroutine put_aperture_elp
4064
4065	subroutine remove_aperture_el(el)
4066	implicit none
4067	type(element),intent(inout):: el
4068
4069	if(associated(el%p%aperture)) then
4070	CALL kill(el%p%APERTURE)
4071	DEALLOCATE(el%p%APERTURE);
4072	endif
4073	end subroutine remove_aperture_el
4074
4075	subroutine remove_aperture_elp(el)
4076	implicit none
4077	type(elementp),intent(inout):: el
4078
4079	if(associated(el%p%aperture)) then
4080	CALL kill(el%p%APERTURE)
4081	DEALLOCATE(el%p%APERTURE);
4082	endif
4083	end subroutine remove_aperture_elp
4084
4085
4086	END MODULE S_DEF_ELEMENT

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

Context Navigation

source: PSPA/madxPSPA/libs/ptc/src/Si_def_element.f90 @ 430

Download in other formats: