Fortraneries/BloubWorld/bloubspace.f90

319 lines
9.0 KiB
Fortran
Raw Normal View History

2022-02-06 23:45:08 +01:00
!
! fonctions de base de gestion des bloubs
!
module bloubspace
implicit none
! ----------------------------------------------------------------
type t_bloubs
character(8) :: nick
logical :: alive
2022-03-18 12:21:40 +01:00
integer :: state
2022-02-18 19:30:10 +01:00
integer :: num ! ???
2022-02-06 23:45:08 +01:00
real :: px, py, pz
real :: vx, vy, vz
real :: radius
2022-03-18 12:21:40 +01:00
integer :: age, agemax
2024-01-25 19:13:45 +01:00
integer :: red, green, blue
2022-02-06 23:45:08 +01:00
end type t_bloubs
2022-03-18 12:21:40 +01:00
type t_boundingbox
character(8) :: id
real :: xm, ym, zm
real :: xp, yp, zp
end type t_boundingbox
2022-02-06 23:45:08 +01:00
contains ! -----------------------------------------
2022-03-18 12:21:40 +01:00
! ----------------------------------------------------------------
subroutine load_boundingbox(infile, where, name)
character(*), intent(in) :: infile
type(t_boundingbox), intent (out) :: where
character(8), intent(in) :: name
integer :: fd, errcode
character(200) :: message
2024-01-25 19:13:45 +01:00
print *, "try to load ", infile, " name ", name
2022-03-18 12:21:40 +01:00
! put some default values
where%id = "default"
where%xm = -5.0 ; where%ym = -5.0 ; where%zm = -5.0
where%xp = 5.0 ; where%yp = 5.0 ; where%zp = 5.0
! and now, try to read the file
open (newunit=fd, file=trim(infile), &
status='old', action='read', &
iostat=errcode, iomsg=message)
if (errcode .NE. 0) then
stop 'OPEN ERROR ' // message
endif
do
read(unit=fd, iostat=errcode, iomsg=message, &
fmt='(A,6F8.3)') where
if (errcode .NE. 0) then
! print *, "errcode ", errcode
print *, "message: ", message
exit
endif
enddo
close(fd)
end subroutine load_boundingbox
! ----------------------------------------------------------------
!-
! coefxyz :
! dispersion de la position autour de l'origine
!-
subroutine make_a_random_bloub(blb, coefxyz)
2022-03-18 12:21:40 +01:00
type(t_bloubs), intent (out) :: blb
real, intent(in) :: coefxyz
2022-02-06 23:45:08 +01:00
! write(0, *) "coef xyz = ", coefxyz
blb%px = coefxyz * (rand() - 0.50)
blb%py = coefxyz * (rand() - 0.50)
blb%pz = coefxyz * (rand() - 0.50)
2022-02-06 23:45:08 +01:00
blb%vx = (rand()) / 5.000
2022-03-18 22:06:12 +01:00
if (blb%px .LT. 0.0) blb%vx = -blb%vx
blb%vy = 0.2 + (rand()) / 8.000
if (blb%py .LT. 0.0) blb%vy = -blb%vy
2022-03-18 22:06:12 +01:00
blb%vz = (rand()) / 5.000
2022-03-18 22:06:12 +01:00
if (blb%pz .LT. 0.0) blb%vz = -blb%vz
2022-02-06 23:45:08 +01:00
2022-03-18 12:21:40 +01:00
blb%state = 0
blb%alive = .TRUE.
blb%age = 0
blb%agemax = 100
2022-02-08 02:53:49 +01:00
2022-02-06 23:45:08 +01:00
end subroutine
2022-02-08 02:53:49 +01:00
! ----------------------------------------------------------------
2022-02-18 19:30:10 +01:00
! Load a blbs file into an array of bloubs
2022-03-18 12:21:40 +01:00
subroutine spit_bloubs_to_file (fname, blbarray, towrite)
character(*), intent(in) :: fname
type(t_bloubs), dimension(:) :: blbarray
integer, intent(in) :: towrite
2022-03-25 22:42:15 +01:00
integer :: errcode, output, foo, spitted
character(200) :: chaine
2024-01-29 10:54:45 +01:00
! write (0, '(" spitting", (I6), " bloubs to ", (A), " file")') &
! towrite, trim(fname)
2022-02-18 19:30:10 +01:00
2022-03-25 22:42:15 +01:00
open( newunit=output, &
file=trim(fname), form='unformatted', &
iostat=errcode, iomsg=chaine, &
action='write', status='replace')
if (0 .ne. errcode) then
write(0, '(" errcode ", I8, 2X, A)') errcode, chaine
STOP " : CAN'T OPEN FILE " // trim(fname)
endif
2022-03-18 12:21:40 +01:00
2022-03-25 22:42:15 +01:00
spitted = 0
do foo=1, towrite
if (blbarray(foo)%alive) then
write(output, iostat=errcode) blbarray(foo)
if (0 .ne. errcode) then
STOP " : WRITE ERROR TO " // trim(fname)
endif
spitted = spitted + 1
endif
enddo
close(output)
2024-01-29 10:54:45 +01:00
write(0, '(1X, "spitted ", I0, " bloubs to .", A)') &
spitted, trim(fname)
2022-03-25 22:42:15 +01:00
end subroutine spit_bloubs_to_file
2022-02-18 19:30:10 +01:00
! ----------------------------------------------------------------
! Dump an array of bloubs to a blbs file.
2022-03-18 12:21:40 +01:00
!
subroutine slurp_bloubs_file_in_array (infile, blbarray, nbread)
character(*), intent(in) :: infile
type(t_bloubs), dimension(:), intent(out) :: blbarray
integer, intent(out) :: nbread
character(200) :: chaine
integer :: input, errcode, idx
2022-03-25 22:42:15 +01:00
integer :: capacity
2022-03-18 12:21:40 +01:00
type(t_bloubs) :: bloub
write(0, '(" slurping from file [", (A), "]")') trim(infile)
open( newunit=input, &
file=trim(infile), form='unformatted', &
iostat=errcode, iomsg=chaine, &
action='read', status='old')
if (0 .ne. errcode) then
write(0, '(" errcode ", I8, 2X, A)') errcode, chaine
STOP " : CAN'T OPEN FILE " // trim(infile)
endif
! write(0, '((A, I3))') " slurping from unit ", input
2022-03-25 22:42:15 +01:00
capacity = ubound(blbarray, 1)
2022-03-18 12:21:40 +01:00
nbread = 0
idx = 1;
do
read (unit=input, iostat=errcode, iomsg=chaine) bloub
if (0 .ne. errcode) then
! may be we got an EOF ?
! write(0, '(" got errcode on read ", (I8,1X,A))') errcode, chaine
exit
endif
nbread = nbread + 1
! print *, bloub%nick, bloub%radius
if (bloub%alive) then
blbarray(idx) = bloub
idx = idx + 1
endif
2022-03-25 22:42:15 +01:00
if (idx .GT. capacity) then
exit
endif
2022-03-18 12:21:40 +01:00
enddo
close(input) ! no error checking ?
2022-03-25 22:42:15 +01:00
! write(0, '(" have read ", (I8), " bloubs")') nbread
2022-03-18 12:21:40 +01:00
2022-03-25 22:42:15 +01:00
end subroutine slurp_bloubs_file_in_array
2022-02-18 19:30:10 +01:00
! ----------------------------------------------------------------
! Display a bloub content to stderr
2022-02-08 02:53:49 +01:00
subroutine display_bloub (blb, message)
type(t_bloubs), intent (in) :: blb
character(*), intent (in) :: message
character(5) :: life
2022-02-06 23:45:08 +01:00
2022-02-08 02:53:49 +01:00
if (blb%alive) then
life = "alive"
else
2022-03-18 12:21:40 +01:00
life = "dead "
2022-02-08 02:53:49 +01:00
endif
2022-02-16 15:59:42 +01:00
write (0, '(4X, A)') '+--------------- ' // message // " -------"
write (0, '(4X,A3,A8,2X,I6,4X,A5,4X,I5)') '| ', &
blb%nick, blb%num, life, blb%age
2022-02-08 18:56:51 +01:00
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
2022-02-08 02:53:49 +01:00
write (0, '()')
end subroutine
2022-02-06 23:45:08 +01:00
! ----------------------------------------------------------------
!-
! Deplacement d'un bloub
!-
2022-02-06 23:45:08 +01:00
subroutine move_bloub (blb, coef)
type(t_bloubs), intent (inout) :: blb
real, intent (in) :: coef
2022-02-07 02:08:17 +01:00
! we must check that this bloub is alive ?
2022-02-06 23:45:08 +01:00
blb%px = blb%px + (blb%vx * coef)
blb%py = blb%py + (blb%vy * coef)
blb%pz = blb%pz + (blb%vz * coef)
end subroutine
! ----------------------------------------------------------------
2022-03-18 12:21:40 +01:00
!
! detection des collisions avec les parois de la boite
! laquelle boite gagnerais beaucoup a etre parametrable,
! ainsi qu'un éventuel coefficient de réduction de la
! vitesse. XXX
2022-03-18 12:21:40 +01:00
!
2022-03-25 22:42:15 +01:00
subroutine bound_a_bloub (blb)
2022-02-08 02:53:49 +01:00
type(t_bloubs), intent (inout) :: blb
2022-03-25 22:42:15 +01:00
real, parameter :: SH = 6.0
real, parameter :: SV = 4.0
2024-01-29 10:54:45 +01:00
logical :: flag
flag = .FALSE.
2022-03-25 22:42:15 +01:00
! X axis
if ((blb%px + blb%radius) .GT. SH) then
2022-02-08 02:53:49 +01:00
blb%vx = -1.0 * blb%vx
blb%px = SH - blb%radius
2022-02-08 02:53:49 +01:00
endif
2022-03-25 22:42:15 +01:00
if ((blb%px - blb%radius) .LT. -SH) then
2022-02-08 02:53:49 +01:00
blb%vx = -1.0 * blb%vx
2022-03-25 22:42:15 +01:00
blb%px = -SH + blb%radius
2024-01-29 10:54:45 +01:00
flag = .TRUE.
2022-02-08 02:53:49 +01:00
endif
2022-03-25 22:42:15 +01:00
! vertical axe Y
if ((blb%py - blb%radius) .LT. -SV) then
2022-02-08 02:53:49 +01:00
blb%vy = -1.0 * blb%vy
2022-03-25 22:42:15 +01:00
blb%py = -SV + blb%radius
2024-01-29 10:54:45 +01:00
flag = .TRUE.
2022-02-08 02:53:49 +01:00
endif
2022-03-25 22:42:15 +01:00
if ((blb%py + blb%radius) .GT. SV) then ! overshoot ?
2022-02-08 02:53:49 +01:00
blb%vy = -1.0 * blb%vy
2022-03-25 22:42:15 +01:00
blb%py = SV - blb%radius
2024-01-29 10:54:45 +01:00
flag = .TRUE.
2022-02-08 02:53:49 +01:00
endif
2022-03-25 22:42:15 +01:00
! Z axis
if ((blb%pz + blb%radius) .GT. SH) then
2022-02-08 02:53:49 +01:00
blb%vz = -1.0 * blb%vz
2022-03-25 22:42:15 +01:00
blb%pz = SH - blb%radius
2024-01-29 10:54:45 +01:00
flag = .TRUE.
2022-02-08 02:53:49 +01:00
endif
2022-03-25 22:42:15 +01:00
if ((blb%pz + blb%radius) .LT. -SH) then
2022-02-08 02:53:49 +01:00
blb%vz = -1.0 * blb%vz
2022-03-25 22:42:15 +01:00
blb%pz = -SH + blb%radius
2024-01-29 10:54:45 +01:00
flag = .TRUE.
endif
if (flag) then
blb%age = blb%age + 1
2022-02-08 02:53:49 +01:00
endif
end subroutine
! ----------------------------------------------------------------
2022-02-16 15:59:42 +01:00
function distance_of_bloubs(bla, blb)
type(t_bloubs), intent(in) :: bla, blb
real :: distance_of_bloubs
real :: dx, dy, dz
dx = (bla%px-blb%px)**2
dy = (bla%py-blb%py)**2
dz = (bla%pz-blb%pz)**2
distance_of_bloubs = sqrt(dx + dy +dz)
end function
! ----------------------------------------------------------------
! kill a bloub under condition(s)
2022-02-08 02:53:49 +01:00
subroutine green_soylent (blb)
type(t_bloubs), intent (inout) :: blb
2022-03-18 12:21:40 +01:00
if (blb%age .gt. 240) then
2022-03-18 12:21:40 +01:00
blb%alive = .FALSE.
endif
! this is juste a molly-guard, don't worry
!
if (blb%radius .GT. 4.0) then
2022-02-08 02:53:49 +01:00
blb%alive = .FALSE.
endif
end subroutine
! ----------------------------------------------------------------
2022-02-06 23:45:08 +01:00
end module