subroutine Track_a_ray_around_ring
use madx_ptc_module
use pointer_lattice
implicit none
type(layout), pointer :: ALS
REAL(dp) X0(6),X(6),R
TYPE(INTERNAL_STATE) STATE
integer i
logical CORRECT
type(fibre), pointer :: p
als=>M_U%start
state=default
write(6,*) " Do you want a correct implementation of exceptions -> yes=true "
read(5,*) CORRECT
WRITE(6,*) " "
WRITE(6,*) " GIVE A 'BIG' INITIAL VALUE (ONE NUMBER) FOR X(1:6)= R (example 0.1) "
READ(5,*) R
X0(1:6)=R
x=x0
p=>als%start
do while(.not.associated(p%next,als%start)) ! this is one turn minus the last element
call track(x,state,fibre1=p,fibre2=p%next)
if(.not.check_stable.and.CORRECT) then
write(6,*) "In the loop"
write(6,"(a255)") messagelost
write(6,*) lost_fibre%pos,lost_fibre%mag%name
write(6,*) "Unstable ray"
WRITE(6,'(6(1x,E15.8))') Xlost
exit
endif
p=>p%next
enddo
if(.not.check_stable) then
write(6,*) "End of loop"
write(6,"(a255)") messagelost
write(6,*) lost_fibre%pos,lost_fibre%mag%name
write(6,*) "Unstable ray"
WRITE(6,'(6(1x,E15.8))') Xlost
else
write(6,*) "stable ray"
WRITE(6,'(6(1x,E15.8))') X
endif
x=x0
call track(x,state,fibre1=als%start,fibre2=als%end) ! this is one turn minus the last element
if(.not.check_stable) then
write(6,*) "Using one call to Track"
write(6,"(a255)") messagelost
write(6,*) lost_fibre%pos,lost_fibre%mag%name
write(6,*) "Unstable ray"
WRITE(6,'(6(1x,E15.8))') Xlost
else
write(6,*) "stable ray"
WRITE(6,'(6(1x,E15.8))') X
endif
end subroutine Track_a_ray_around_ring