117 lines
3.1 KiB
Fortran
117 lines
3.1 KiB
Fortran
program mergebloubs
|
|
|
|
!-------------------------------------------!
|
|
! THIS IS A BIG MESS OF BUGS !
|
|
!-------------------------------------------!
|
|
|
|
use bloubspace
|
|
use mathstuff2
|
|
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, A, 1X, A, 1X, I6)') "### mergebloubs ", &
|
|
trim(infile), trim(outfile), NB_MAX_BLOUBS
|
|
|
|
call init_random_seed()
|
|
|
|
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
|
|
|
|
! call display_bloub (bloubs(ia), "juste merged")
|
|
|
|
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)
|
|
implicit none
|
|
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
|
|
if (0.001 .GT. rand()) then
|
|
blr%vx = blr%vx * 1.04
|
|
blr%vy = blr%vy * 1.04
|
|
blr%vz = blr%vz * 1.04
|
|
endif
|
|
|
|
blr%radius = (va + vb) ** 0.33335
|
|
blr%age = min(bla%age, blb%age)
|
|
|
|
! bring it to life !
|
|
blr%alive = .TRUE.
|
|
|
|
end subroutine
|
|
|
|
end program
|
|
|
|
|