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