63 lines
1.9 KiB
Fortran
Executable File
63 lines
1.9 KiB
Fortran
Executable File
!----------------------------------------------------------------------------------------
|
|
! test for precession, ge nieuwenhuys, Oktober 25, 2005
|
|
!----------------------------------------------------------------------------------------
|
|
!
|
|
! The initial muon direction is given by the unit vector emu, the magnetic field
|
|
! is b (vector) and the observer (positroncounter) is supposed to be in the
|
|
! direction of the unit-vector observer.
|
|
!
|
|
USE DFLIB
|
|
!
|
|
real*8 b(3), eb(3), emu(3), gyro(3), azi(3), length_b, length_gyro, length_azi
|
|
real*8 observer(3), amplitude, help(3), cos_phase, phase, g_t_x, g_t_y, g_t_z, omega
|
|
real*8 length, saclar_pruduct, length_vector_product
|
|
|
|
1 write(6,2)
|
|
2 format(' Give initial muon > '\)
|
|
read(5,*,err=1) emu
|
|
emu = emu / length(emu)
|
|
3 write(6,4)
|
|
4 format(' Give field > '\)
|
|
read(5,*,err=3) b
|
|
length_b = length( b )
|
|
IF ( length_b .LT. 0.001 ) GOTO 1
|
|
!
|
|
open(1,file='e:\simulations\rotatie.dat',status='unknown')
|
|
eb = b / length_b
|
|
omega = 135. * 6.28 * length_b
|
|
!
|
|
DO i = 1, 100
|
|
!
|
|
t = float(i-1) * 0.01
|
|
!
|
|
c = cos( omega * t )
|
|
s = sin( omega * t )
|
|
!
|
|
g_t_x = ( c + eb(1)*eb(1)*(1-c) ) * emu(1) + &
|
|
& ( eb(1)*eb(2)*(1-c)-eb(3)*s ) * emu(2) + &
|
|
& ( eb(2)*s+eb(1)*eb(3)*(1-c) ) * emu(3)
|
|
!
|
|
g_t_y = ( eb(3)*s+eb(1)*eb(2)*(1-c) ) * emu(1) + &
|
|
& ( c + eb(2)*eb(2) * (1-c) ) * emu(2) + &
|
|
& ( -eb(1)*s+eb(2)*eb(3)*(1-c)) * emu(3)
|
|
!
|
|
g_t_z = ( -eb(2)*s+eb(1)*eb(3)*(1-c)) * emu(1) + &
|
|
& ( eb(1)*s+eb(2)*eb(3)*(1-c)) * emu(2) + &
|
|
& ( c+eb(3)*eb(3)*(1-c) ) * emu(3)
|
|
!
|
|
write(1,'(4E18.6)') t, g_t_x, g_t_y, g_t_z
|
|
!
|
|
END DO
|
|
!
|
|
Close(1)
|
|
GOTO 3
|
|
!
|
|
END
|
|
!
|
|
real*8 FUNCTION length( v )
|
|
real*8 v(3)
|
|
length = sqrt( sum( v * v ) )
|
|
RETURN
|
|
END
|
|
!
|