123 lines
2.9 KiB
Fortran
123 lines
2.9 KiB
Fortran
!
|
|
! fonctions de base de gestion des bloubs
|
|
!
|
|
|
|
module bloubspace
|
|
|
|
implicit none
|
|
|
|
! ----------------------------------------------------------------
|
|
|
|
type t_bloubs
|
|
character(8) :: nick
|
|
logical :: alive
|
|
integer :: num
|
|
real :: px, py, pz
|
|
real :: vx, vy, vz
|
|
real :: radius
|
|
integer :: seq
|
|
end type t_bloubs
|
|
|
|
contains ! -----------------------------------------
|
|
|
|
subroutine random_pv (blb)
|
|
type(t_bloubs), intent (inout) :: blb
|
|
|
|
blb%px = 2.0 * (rand() - 0.50)
|
|
blb%py = rand() * 0.50
|
|
blb%pz = 2.0 * (rand() - 0.50)
|
|
|
|
blb%vx = (rand() - 0.5) / 3.000
|
|
blb%vy = (rand() - 0.5) / 3.000
|
|
blb%vz = (rand() - 0.5) / 3.000
|
|
|
|
blb%alive = .TRUE.
|
|
|
|
end subroutine
|
|
! ----------------------------------------------------------------
|
|
|
|
subroutine display_bloub (blb, message)
|
|
type(t_bloubs), intent (in) :: blb
|
|
character(*), intent (in) :: message
|
|
|
|
character(5) :: life
|
|
|
|
if (blb%alive) then
|
|
life = "alive"
|
|
else
|
|
life = "dead"
|
|
endif
|
|
write (0, '(4X, A)') '+------------ ' // message
|
|
write (0, '(4X,A3,A8,2X,I6,4X,A5)') '| ', blb%nick, blb%num, life
|
|
write (0, '(4X,A3,3X,3(F8.3, 4X))') '| P', blb%px, blb%py, blb%pz
|
|
write (0, '(4X,A3,3X,3(F8.3, 4X))') '| V', blb%vx, blb%vy, blb%vz
|
|
write (0, '()')
|
|
|
|
end subroutine
|
|
! ----------------------------------------------------------------
|
|
|
|
subroutine move_bloub (blb, coef)
|
|
type(t_bloubs), intent (inout) :: blb
|
|
real, intent (in) :: coef
|
|
|
|
! we must check that this bloub is alive ?
|
|
|
|
blb%px = blb%px + (blb%vx * coef)
|
|
blb%py = blb%py + (blb%vy * coef)
|
|
blb%pz = blb%pz + (blb%vz * coef)
|
|
|
|
end subroutine
|
|
! ----------------------------------------------------------------
|
|
subroutine bound_a_blob (blb)
|
|
type(t_bloubs), intent (inout) :: blb
|
|
|
|
if (5.0 .lt. blb%px) then
|
|
blb%vx = -1.0 * blb%vx
|
|
blb%px = 5.0
|
|
blb%seq = blb%seq + 1
|
|
endif
|
|
if (-5.0 .gt. blb%px) then
|
|
blb%vx = -1.0 * blb%vx
|
|
blb%px = -5.0
|
|
blb%seq = blb%seq + 1
|
|
endif
|
|
|
|
if (0.0 .gt. blb%py) then
|
|
blb%vy = -1.0 * blb%vy
|
|
blb%py = 0.0
|
|
blb%seq = blb%seq + 1
|
|
endif
|
|
if (3.0 .lt. blb%py) then
|
|
blb%vy = -1.0 * blb%vy
|
|
blb%seq = blb%seq + 1
|
|
blb%py = 3.0
|
|
endif
|
|
|
|
if (5.0 .lt. blb%pz) then
|
|
blb%vz = -1.0 * blb%vz
|
|
blb%seq = blb%seq + 1
|
|
blb%pz = 5.0
|
|
endif
|
|
if (-5.0 .gt. blb%pz) then
|
|
blb%vz = -1.0 * blb%vz
|
|
blb%seq = blb%seq + 1
|
|
blb%pz = -5.0
|
|
endif
|
|
|
|
end subroutine
|
|
|
|
! ----------------------------------------------------------------
|
|
subroutine green_soylent (blb)
|
|
type(t_bloubs), intent (inout) :: blb
|
|
if (blb%seq .gt. 4) then
|
|
blb%alive = .FALSE.
|
|
endif
|
|
end subroutine
|
|
! ----------------------------------------------------------------
|
|
|
|
|
|
end module
|
|
|
|
|
|
|