Fortraneries/BloubWorld/movebloubs.f90
2022-03-18 12:21:40 +01:00

138 lines
3.5 KiB
Fortran

program movebloubs
use bloubspace
use povstuff
use mathstuff
implicit none
character(200) :: infile, outfile
integer :: inu, outu, errcode, i
integer :: compteur, killed
type(t_bloubs) :: bloub
double precision :: bx, by, bz
! logical :: add_new_bloub = .TRUE.
real :: rnd
call init_random_seed()
i = IARGC()
if (i .ne. 2) then
STOP ": BAD ARGS ON COMMAND LINE"
endif
call getarg(1, infile)
call getarg(2, outfile)
write (0, '(A)') &
"*** moving bloubs from "//trim(infile)//" to "//trim(outfile)
open(newunit=inu, &
file=trim(infile), form='unformatted', &
iostat=errcode, &
action='read', status='old')
if (0 .ne. errcode) then
STOP " : CAN'T OPEN FILE " // trim(infile)
endif
open(newunit=outu, &
file=trim(outfile), form='unformatted', &
iostat=errcode, &
action='write', status='replace')
if (0 .ne. errcode) then
STOP " : CAN'T OPEN " // trim(outfile) // "FOR WRITE"
endif
! write(0, '("Units: ", 2I5)') inu, outu
bx = 0.0; by = 0.0; bz = 0.0
compteur = 0
killed = 0
do
read (unit=inu, iostat=errcode) bloub
if (0 .ne. errcode) then
! may be we got an EOF ?
exit
endif
! moving, morphing and boundingboxing
call move_bloub (bloub, 0.185)
call bound_a_blob (bloub)
if (bloub%radius .GT. 0.0151) then
bloub%radius = bloub%radius * 0.9970
endif
call green_soylent (bloub)
if (.NOT. bloub%alive) then
! write(0, '(A)') " KILL!"
killed = killed + 1
! cycle ! ???
endif
! calcul du barycentre
bx = bx + dble(bloub%px)
by = by + dble(bloub%py)
bz = bz + dble(bloub%pz)
write(outu, iostat=errcode) bloub ! no error control ?
if (0 .ne. errcode) then
STOP " : WRITE ERROR TO " // trim(outfile)
endif
compteur = compteur + 1
enddo ! end of main loop
write(0, '(I5,1X,A)') compteur, "bloubs processed"
! ok, we have read all the bloubs in the input file
! insert some fancy conditional here
if (compteur .LT. 3000) then
rnd = rand()
write (0, '(A,1X,F9.6)') "try to add bloubs, rnd is", rnd
if (rnd .LT. 0.0450) then
call add_more_bloubs(outu, 24, 0.0990)
endif
endif
close(inu) ; close(outu)
if (killed .GT. 0) then
write (0, '(I5,A)') killed, " bloubs killed"
endif
bx = bx / dble(compteur)
by = by / dble(compteur)
bz = bz / dble(compteur)
write (0, '(A,3(F12.6,3X))') "barycentre : ", bx, by, bz
! --------------------------------------------------------------
contains
subroutine add_more_bloubs(un, nbre, rayon)
integer, intent(in) :: un, nbre
real, intent(in) :: rayon
type(t_bloubs) :: bloub
integer :: foo, count
count = nbre+mod(irand(), 7)
write(0, '(A,I4,1X,A)') "adding", count, "bloubs"
do foo=1, count
bloub%nick = 'newbie '
call random_pv(bloub)
bloub%radius = rayon + (0.15*rand())
bloub%age = 1
bloub%alive = .TRUE.
bloub%num = mod(irand(), 42)
write(un) bloub ! no error control ?
enddo
end subroutine
! --------------------------------------------------------------
end program movebloubs