Fortraneries/BloubWorld/mergebloubs.f90

program mergebloubs

          !-------------------------------------------!
          !       THIS IS A BIG MESS OF BUGS          !
          !-------------------------------------------!

  use bloubspace
  implicit none

  integer, parameter       :: NB_MAX_BLOUBS = 250000

  character(200)           :: infile, outfile
  ! type(t_bloubs)           :: bloub, newbloub
  integer                  :: errcode, nbgot
  type(t_bloubs), dimension(:), allocatable  :: bloubs
  integer                  :: ia, ib, contacts
  real                     :: dist,radd
  type(t_bloubs)           :: merged

! --------------- check command line parameters
  if (IARGC() .ne. 2) then
    STOP ": NEED IN AND OUT FILENAME"
  endif
  call getarg(1, infile)
  call getarg(2, outfile)

  write(0, '(A, 2A15, I8)') "### mergebloubs ",        &
                 trim(infile), trim(outfile), NB_MAX_BLOUBS

  allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
  if (0 .NE. errcode) then
    STOP " : NO ENOUGH MEMORY"
  endif

  call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot)
  write(0, '(A,I0,1X,A)') " slurped ", nbgot, "bloubs"

  contacts = 0
  do ia = 1, nbgot
    ! print *, ia, "  =   ", les_bloubs(ia)%nick, les_bloubs(ia)%num
    do ib = ia+1, nbgot
      dist = distance_of_bloubs(bloubs(ia), bloubs(ib))
      radd = bloubs(ia)%radius + bloubs(ib)%radius
      if (dist .LT. radd) then

        contacts = contacts + 1
        call merge_two_bloubs(bloubs(ia), bloubs(ib), merged)
        bloubs(ia)       = merged
        bloubs(ia)%nick  = "marged"
        bloubs(ia)%state = 1;
        bloubs(ib)%alive = .FALSE.
        write(0, *) "  *** merged ", ia, " and ", ib,       &
                    "   new r = ",  merged%radius

      endif

    enddo
  enddo

  call spit_bloubs_to_file (outfile, bloubs, nbgot)
  if (contacts .GT. 0) then
    write(0, '(A,I0,A,I0,A)') &
          " merge: ", contacts, " contacts pour ", nbgot, " bloubs"
  endif

  ! STOP 'mergebloubs [done]'

! ==============================================================

contains

  subroutine merge_two_bloubs(bla, blb, blr)
      type(t_bloubs), intent(in)   :: bla, blb
      type(t_bloubs), intent(out)  :: blr

      real             :: va, vb
!-
! XXX please insert here a static counter for the 'num' id
!-

      blr%nick     = "merged  "
      blr%num      = 0                !    ???

      va = bla%radius * bla%radius * bla%radius
      vb = blb%radius * blb%radius * blb%radius

      blr%px = (bla%px + blb%px) / 2.0
      blr%py = (bla%py + blb%py) / 2.0
      blr%pz = (bla%pz + blb%pz) / 2.0

      blr%vx = (bla%vx + blb%vx) / 2.0
      blr%vy = (bla%vy + blb%vy) / 2.0
      blr%vz = (bla%vz + blb%vz) / 2.0

      blr%radius = (va + vb) ** 0.33333333333
      blr%age = min(bla%age, blb%age)

      ! bring it to life !
      blr%alive    = .TRUE.

  end subroutine

end program