!=================================================================
subroutine Track_and_with_rad
use madx_ptc_module
use pointer_lattice
use gauss_dis
implicit none
type(layout), pointer :: ALS
real(dp) x(6),sig0(6),energy,deltap,sizes(6,6),bet(3),bet0,betf,t
type(probe) xs0,xs1
type(probe_8) xs
type(real_8) y(6)
type(damapspin) m,m1,m2
type(damap) id
type(internal_state) state,wrapped_state
type(fibre), pointer ::p
integer i,mf,j,n
type(normal_spin) nf
type(normalform) normal
real(dp) stoch(6,6),stochi(6,6),r(3),mat(6,6)
als=>M_U%start
state=default0+radiation0+envelope0
p=>als%start
do i=1,als%n
p%AG=.1d0 ! a_etienne
p=>p%next
enddo
sig0=1.d-6
sig0(6)=1.d-4
call MESS_UP_ALIGNMENT(als,SIG0,3.d0)
CALL INIT(state,2,0)
call alloc(m)
call alloc(m1)
call alloc(m2)
call alloc(xs)
call alloc(nf)
call alloc(id)
call alloc(y)
call alloc(normal)
nf%stochastic=my_true
!!!! Tracking with a wrapped command !!!!!!!!!!
wrapped_state=default0+radiation0
CALL FIND_ORBIT_x(als,X,wrapped_state,1.0e-5_dp,fibre1=1)
WRITE(6,'(A)') " Closed orbit with Radiation "
WRITE(6,'(6(1x,E15.8))') x
call GET_loss(als,energy,deltap)
write(6,'(a32,2(1x,E15.8))') "Energy loss: GEV and DeltaP/p0c ",energy,deltap
id=1
y=x+id
call TRACK_PROBE_X(ALS,y,wrapped_state, FIBRE1=1)
id=y
normal=id ! Normal is a regular Normalform type
write(6,*) "Tunes "
write(6,*) normal%tune(1:3)
write(6,*) "Damping decrements"
write(6,*) normal%damping(1:3)
!!!!!!!!!! end of Tracking with a wrapped command !!!!!!!!!!
!!!!!!!!!! Tracking a probe_8 to get the map !!!!!!!!!!
state=default0+radiation0+envelope0
xs0=x ! closed orbit intializing a probe
m=1 ! damapspin set to identity
xs=xs0+m ! Probe_8 = closed orbit probe + Identity
call track_probe(als,xs,state,fibre1=1)
m=xs ! damapspin = Probe_8
nf=m ! normal_spin = damapspin (Normalization including spin (if present) or radiation
! envelope if present. (Spin without radiation)
write(6,*) nf%n%tune(1:3)
write(6,*) nf%emittance
write(6,*) nf%s_ij0(1,1),nf%s_ij0(5,5)
!!!!!!!!!! end Tracking a probe_8 to get the map !!!!!!!!!!
mat=m%m
!!!!!!!!!! Tracking a probe_8 to beam sizes around the ring !!!!!!!!!!
call kanalnummer(mf,"beam_xx_inf.dat")
state=default0+radiation0+envelope0
xs0=x ! closed orbit intializing a probe
m=1 ! damapspin set to identity
xs=xs0+m ! Probe_8 = closed orbit probe + Identity
p=>als%start
call extract_beam_sizes(xs,nf%s_ij0,sizes)
write(mf,*) p%mag%name, sizes(1,1)
do i=1,als%n
call track_probe(als,xs,state,fibre1=i,fibre2=i+1)
call extract_beam_sizes(xs,nf%s_ij0,sizes)
p=>p%next
write(mf,*) p%mag%name, sizes(1,1)
enddo
close(mf)
!!!!!!!!!! Tracking a probe_8 to beam sizes around the ring using emittances !!!!!!!!!!
call kanalnummer(mf,"beam_xx_inf_using_emittances.dat")
state=default0+radiation0+envelope0
xs0=x ! closed orbit intializing a probe
m=nf%a_t ! damapspin set to A
xs=xs0+m ! Probe_8 = closed orbit probe + Identity
p=>als%start
bet(1)=(m%m%v(1).sub.'1')**2+(m%m%v(1).sub.'01')**2
bet(2)=(m%m%v(1).sub.'001')**2+(m%m%v(1).sub.'0001')**2
bet(3)=(m%m%v(1).sub.'00001')**2+(m%m%v(1).sub.'000001')**2
sizes(1,1)=(bet(1)*nf%emittance(1)+bet(2)*nf%emittance(2)+bet(3)*nf%emittance(3))
bet0=sizes(1,1)
write(mf,*) p%mag%name, sizes(1,1)
do i=1,als%n
call track_probe(als,xs,state,fibre1=i,fibre2=i+1)
m=xs
bet(1)=(m%m%v(1).sub.'1')**2+(m%m%v(1).sub.'01')**2
bet(2)=(m%m%v(1).sub.'001')**2+(m%m%v(1).sub.'0001')**2
bet(3)=(m%m%v(1).sub.'00001')**2+(m%m%v(1).sub.'000001')**2
sizes(1,1)=(bet(1)*nf%emittance(1)+bet(2)*nf%emittance(2)+bet(3)*nf%emittance(3))
p=>p%next
write(mf,*) p%mag%name, sizes(1,1)
enddo
betf=sizes(1,1)
write(mf,*) " log of change after one turn and damping "
write(mf,*) log(betf/bet0)/2.d0,nf%n%damping(1)
close(mf)
!!!!!!!!!! Tracking a probe_8 to beam sizes around the ring using emittances !!!!!!!!!!
call kanalnummer(mf,"beam_xx_inf_using_emittances_ripken.dat")
state=default0+radiation0+envelope0
xs0=x ! closed orbit intializing a probe
m=nf%a_t ! damapspin set to A
xs=xs0+m ! Probe_8 = closed orbit probe + Identity
p=>als%start
id=(m%m.sub.1)**(-1)
bet(1)=(m%m%v(1).sub.'1')*(id%v(2).sub.'01')-(m%m%v(1).sub.'01')*(id%v(1).sub.'01')
bet(2)=(m%m%v(1).sub.'001')*(id%v(4).sub.'01')-(m%m%v(1).sub.'0001')*(id%v(3).sub.'01')
bet(3)=(m%m%v(1).sub.'00001')*(id%v(6).sub.'01')-(m%m%v(1).sub.'000001')*(id%v(5).sub.'01')
sizes(1,1)=(bet(1)*nf%emittance(1)+bet(2)*nf%emittance(2)+bet(3)*nf%emittance(3))
write(mf,*) p%mag%name, sizes(1,1)
do i=1,als%n
call track_probe(als,xs,state,fibre1=i,fibre2=i+1)
m=xs
id=(m%m.sub.1)**(-1)
bet(1)=(m%m%v(1).sub.'1')*(id%v(2).sub.'01')-(m%m%v(1).sub.'01')*(id%v(1).sub.'01')
bet(2)=(m%m%v(1).sub.'001')*(id%v(4).sub.'01')-(m%m%v(1).sub.'0001')*(id%v(3).sub.'01')
bet(3)=(m%m%v(1).sub.'00001')*(id%v(6).sub.'01')-(m%m%v(1).sub.'000001')*(id%v(5).sub.'01')
sizes(1,1)=(bet(1)*nf%emittance(1)+bet(2)*nf%emittance(2)+bet(3)*nf%emittance(3))
p=>p%next
write(mf,*) p%mag%name, sizes(1,1)
enddo
close(mf)
!!!!!!!!!! End of Tracking a probe_8 to beam sizes around the ring using emittances and super-lattices functions !!!!!!!!!!
stoch=nf%stoch
id=stoch
id=id**(-1)
stochi=id
x=0.d0
sizes=0.d0
write(6,*) " Give the number of turns > 1 million"
read(5,*) n
do i=1,n
x=matmul(mat,x)
x=matmul(stoch,x)
do j=1,3
t=RANF()
if(t>half) then
t=one
else
t=-one
endif
x(2*j-1)= x(2*j-1)+ t*nf%kick(j)
x(2*j ) = x(2*j)+ t*nf%kick(j)
enddo
x=matmul(stochi,x)
sizes(1,1)=sizes(1,1)+x(1)**2
sizes(2,2)=sizes(2,2)+x(2)**2
sizes(1,3)=sizes(1,3)+x(1)*x(3)
enddo
sizes=sizes/n
write(6,*) sizes(1,1), sizes(2,2), sizes(1,3)
write(6,*) nf%s_ij0(1,1), nf%s_ij0(2,2), nf%s_ij0(1,3)
call kill(m)
call kill(m1)
call kill(m2)
call kill(xs)
call kill(nf)
call kill(id)
call kill(y)
call kill(normal)
end subroutine Track_and_with_rad