2022-02-16 17:10:05 +01:00
|
|
|
program mergebloubs
|
|
|
|
|
|
2022-03-18 22:08:08 +01:00
|
|
|
!-------------------------------------------!
|
|
|
|
|
! THIS IS A BIG MESS OF BUGS !
|
|
|
|
|
!-------------------------------------------!
|
|
|
|
|
|
2022-02-16 17:10:05 +01:00
|
|
|
use bloubspace
|
|
|
|
|
implicit none
|
|
|
|
|
|
2022-03-25 22:42:15 +01:00
|
|
|
integer, parameter :: NB_MAX_BLOUBS = 250000
|
2022-02-16 17:10:05 +01:00
|
|
|
|
|
|
|
|
character(200) :: infile, outfile
|
2022-03-25 22:42:15 +01:00
|
|
|
! 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
|
2022-02-16 17:10:05 +01:00
|
|
|
|
|
|
|
|
! --------------- check command line parameters
|
|
|
|
|
if (IARGC() .ne. 2) then
|
|
|
|
|
STOP ": NEED IN AND OUT FILENAME"
|
|
|
|
|
endif
|
|
|
|
|
call getarg(1, infile)
|
|
|
|
|
call getarg(2, outfile)
|
|
|
|
|
|
2022-03-25 22:42:15 +01:00
|
|
|
write(0, '(A, 2A15, I8)') "### mergebloubs ", &
|
2022-03-18 22:08:08 +01:00
|
|
|
trim(infile), trim(outfile), NB_MAX_BLOUBS
|
2022-02-16 17:10:05 +01:00
|
|
|
|
2022-03-25 22:42:15 +01:00
|
|
|
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)
|
2024-01-29 05:25:08 +01:00
|
|
|
write(0, '(A,I0,1X,A)') " slurped ", nbgot, "bloubs"
|
2022-03-25 22:42:15 +01:00
|
|
|
|
|
|
|
|
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
|
2024-01-29 05:25:08 +01:00
|
|
|
|
2022-03-25 22:42:15 +01:00
|
|
|
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.
|
2024-01-29 05:25:08 +01:00
|
|
|
write(0, *) " *** merged ", ia, " and ", ib, &
|
|
|
|
|
" new r = ", merged%radius
|
|
|
|
|
|
2022-03-25 22:42:15 +01:00
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
call spit_bloubs_to_file (outfile, bloubs, nbgot)
|
2024-01-29 05:25:08 +01:00
|
|
|
if (contacts .GT. 0) then
|
|
|
|
|
write(0, '(A,I0,A,I0,A)') &
|
|
|
|
|
" merge: ", contacts, " contacts pour ", nbgot, " bloubs"
|
|
|
|
|
endif
|
2022-03-25 22:42:15 +01:00
|
|
|
|
|
|
|
|
! STOP 'mergebloubs [done]'
|
2022-03-18 22:08:08 +01:00
|
|
|
|
2022-03-25 22:42:15 +01:00
|
|
|
! ==============================================================
|
2022-02-16 17:10:05 +01:00
|
|
|
|
|
|
|
|
contains
|
|
|
|
|
|
|
|
|
|
subroutine merge_two_bloubs(bla, blb, blr)
|
|
|
|
|
type(t_bloubs), intent(in) :: bla, blb
|
|
|
|
|
type(t_bloubs), intent(out) :: blr
|
|
|
|
|
|
2022-03-20 22:05:06 +01:00
|
|
|
blr%nick = "merged "
|
2022-02-16 17:10:05 +01:00
|
|
|
blr%num = 0 ! ???
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
2024-01-29 05:25:08 +01:00
|
|
|
blr%radius = (bla%radius + blb%radius)
|
|
|
|
|
blr%age = max(bla%age, blb%age)
|
2022-02-16 17:10:05 +01:00
|
|
|
|
|
|
|
|
! bring it to life !
|
|
|
|
|
blr%alive = .TRUE.
|
|
|
|
|
|
|
|
|
|
end subroutine
|
|
|
|
|
|
|
|
|
|
end program
|
|
|
|
|
|
|
|
|
|
|
