Fortraneries/BloubWorld/movebloubs.f90

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_bloub  (bloub)
    if (bloub%radius .GT. 0.0238) then
      bloub%radius = bloub%radius * 0.996
    endif

    call green_soylent (bloub)
    if (.NOT. bloub%alive) then
      ! write(0, '(A)') "   KILL!"
      killed = killed  + 1
    endif

    ! calcul du barycentre
    bx = bx + dble(bloub%px)
    by = by + dble(bloub%py)
    bz = bz + dble(bloub%pz)

    if (bloub%alive) then
      write(outu, iostat=errcode) bloub   
      if (0 .ne. errcode) then
        STOP " : WRITE ERROR TO " // trim(outfile)
      endif
      compteur = compteur + 1
    endif

  enddo                     ! end of main loop

  write(0, '(1X,I0,1X,A)') compteur, "bloubs processed"

  ! ok, we have read all the bloubs in the input file

  ! insert some fancy conditional here
  if (compteur .LT.  200) then
    call add_more_bloubs(outu, 4, 0.026)
  endif

  ! insert some very fancy conditional here
  if (compteur .LT. 800) then
    rnd = rand()
    ! write (0, '(A,1X,F9.6)') "try to add bloubs, rnd is", rnd
    if (rnd .LT. 0.0604) then
      call add_more_bloubs(outu, 11, 0.019)
    endif
  endif

  close(inu)    ;    close(outu)

  if (killed .GT. 0) then
    write (0, '(1X,I0,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(), 6)
  write(0, '(A,I4,1X,A)') "adding", count, "bloubs"

  do foo=1, count

    bloub%nick = 'newbie  '
    call make_a_random_bloub(bloub)
    bloub%radius = rayon + (0.05*rand())
    bloub%age   = 1
    bloub%alive = .TRUE.
    bloub%num   = mod(irand(), 42)
    write(un) bloub              ! no error control ?

  enddo

  end subroutine

! --------------------------------------------------------------

end program movebloubs