next up previous contents
Next: Subroutine Track_a_ray_time(RADIATION_FLAG,SPIN_FLAG) Up: Small Example Programs Previous: Small Example Programs   Contents


Subroutine Track_a_ray(RADIATION_FLAG,SPIN_FLAG)

subroutine  Track_a_ray(RADIATION_FLAG,SPIN_FLAG)
use madx_ptc_module
use pointer_lattice
implicit none
type(layout), pointer :: ALS
REAL(dp) X0(6),X(6),R,DT
TYPE(PROBE) XS
TYPE(TEMPORAL_PROBE) XT
TYPE(INTERNAL_STATE) STATE
LOGICAL(LP) RADIATION_FLAG,SPIN_FLAG
integer i

als=>M_U%start
STATE=DEFAULT+TOTALPATH

IF(RADIATION_FLAG) THEN
 STATE=STATE+RADIATION0
 WRITE(6,*) "RADIATION IS ON "
ENDIF
IF(SPIN_FLAG) THEN
 STATE=STATE+SPIN0
 WRITE(6,*) "SPIN IS ON "
ENDIF



write(6,*) "  "
WRITE(6,*) "   " 
WRITE(6,*) " GIVE INITIAL VALUE (ONE NUMBER) FOR X(1:6)= R " 
READ(5,*) R
X0(1:6)=R
write(6,*) "ONE TURN AROUND WITH FIBRES -> NO RADIATION AND NO SPIN"
!EXAMPLE 1.1 
! ONE TURN AROUND WITH FIBRES -> NO RADIATION AND NO SPIN
X=X0
CALL TRACK(ALS,X,1,STATE)
IF(CHECK_STABLE) THEN
 WRITE(6,'(6(1x,E15.8))') X
ELSE
  WRITE(6,"(A255)") MESSAGELOST
  WRITE(6,"(A24)") LOST_FIBRE%MAG%NAME
  WRITE(6,*) " FIBRE POSITION ",LOST_FIBRE%POS
ENDIF
!CALL RESET_APERTURE_FLAG
write(6,*) "  "
write(6,*) "ONE TURN AROUND WITH WRAPPED PROBE  ->  NO SPIN"
!EXAMPLE 1.2 
! ONE TURN AROUND WITH WRAPPED PROBE  ->  NO SPIN
X=X0
CALL TRACK_PROBE_X(ALS,X,STATE,FIBRE1=1)
IF(CHECK_STABLE) THEN
 WRITE(6,'(6(1x,E15.8))') X
ELSE
  WRITE(6,"(A255)") MESSAGELOST
  WRITE(6,"(A24)") LOST_FIBRE%MAG%NAME
  WRITE(6,*) " FIBRE POSITION ",LOST_FIBRE%POS
  WRITE(6,*) " NODE POSITION ",LOST_NODE%POS
ENDIF

write(6,*) "  "
write(6,*) "ONE TURN AROUND WITH PROBE -> SPIN AND RADIATION POSSIBLE"
!EXAMPLE 1.3
! ONE TURN AROUND WITH PROBE -> SPIN AND RADIATION POSSIBLE
XS=X0
CALL TRACK_PROBE(ALS,XS,STATE,FIBRE1=1)
IF(CHECK_STABLE) THEN
WRITE(6,'(6(1x,E15.8))') XS%X
WRITE(6,*) " SPINORS "
WRITE(6,'(6(1x,E15.8))') XS%S(1)
WRITE(6,'(6(1x,E15.8))') XS%S(2)
WRITE(6,'(6(1x,E15.8))') XS%S(3)
ELSE
  WRITE(6,"(A255)") MESSAGELOST
  WRITE(6,"(A24)") LOST_FIBRE%MAG%NAME
  WRITE(6,*) " FIBRE POSITION ",LOST_FIBRE%POS
  WRITE(6,*) " NODE POSITION ",LOST_NODE%POS
ENDIF

  
call FILL_SURVEY_DATA_IN_NODE_LAYOUT(ALS)

write(6,*) "  "
write(6,*) "TIME TRACKING "

XS=X0
XT%XS=XS
XT%POS=0.D0
XT%NODE=>ALS%T%START
XT%DS=0.D0
  DT=(0.19683851D+03+1.D-3) 
  
CALL TRACK_time(XT,DT,STATE)
IF(CHECK_STABLE) THEN
WRITE(6,*) " TIME TRACKING  ", dt
WRITE(6,'(6(1x,E15.8))') XT%XS%X
WRITE(6,*) " SPINORS "
WRITE(6,'(6(1x,E15.8))') XT%XS%S(1)
WRITE(6,'(6(1x,E15.8))') XT%XS%S(2)
WRITE(6,'(6(1x,E15.8))') XT%XS%S(3)
WRITE(6,*) " POSITION "
WRITE(6,'(6(1x,E15.8))') XT%POS
WRITE(6,*) XT%NODE%PARENT_FIBRE%POS, XT%NODE%PARENT_FIBRE%MAG%NAME
ELSE
  WRITE(6,"(A255)") MESSAGELOST
  WRITE(6,"(A24)") LOST_FIBRE%MAG%NAME
  WRITE(6,*) " FIBRE POSITION ",LOST_FIBRE%POS
  WRITE(6,*) " NODE POSITION ",LOST_NODE%POS
ENDIF

end subroutine Track_a_ray


Frank Schmidt 2010-10-15