diff --git a/BloubWorld/Makefile b/BloubWorld/Makefile index 4b50f23..ec22278 100644 --- a/BloubWorld/Makefile +++ b/BloubWorld/Makefile @@ -12,7 +12,7 @@ initial.blbs: genbloubs Makefile ./genbloubs $@ 1000 in.blbs: genbloubs Makefile - ./genbloubs $@ 10000 + ./genbloubs $@ 300 out.blbs: in.blbs mergebloubs Makefile ./mergebloubs $< $@ diff --git a/BloubWorld/mergebloubs.f90 b/BloubWorld/mergebloubs.f90 new file mode 100644 index 0000000..3ec40db --- /dev/null +++ b/BloubWorld/mergebloubs.f90 @@ -0,0 +1,154 @@ +program mergebloubs + + use bloubspace + implicit none + + integer, parameter :: NB_MAX_BLOUBS = 20000 + + character(200) :: infile, outfile + type(t_bloubs) :: bloub, newbloub + integer :: inu, outu, errcode + + type(t_bloubs), dimension(:), allocatable :: les_bloubs + integer :: i, idx, nbr_merge + real :: rval + logical :: 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, '(2A20, I8)') trim(infile), trim(outfile), NB_MAX_BLOUBS + +! --------------- allocate memory for the people + + allocate (les_bloubs(NB_MAX_BLOUBS), stat=errcode) + if (0 .NE. errcode) then + STOP " : NO ENOUGH MEMORY" + endif + + do i = 1, NB_MAX_BLOUBS + les_bloubs(i)%alive = .FALSE. + enddo + +! --------------- open / creat the files + + 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 + +! --------------- read the first bloub + + idx = 1 + + read (unit=inu, iostat=errcode) bloub + if (0 .ne. errcode) then + STOP " : ERR READING FIRST BLOUB" + endif + call display_bloub (bloub, "first bloub") + les_bloubs(idx) = bloub + idx = idx + 1 + +! --------------- loop over the other bloubs + nbr_merge = 0 + + do ! infinite loop + + print *, "============ PASS ", idx + ! read the next bloub from input file + read (unit=inu, iostat=errcode) bloub + if (0 .ne. errcode) then + exit + endif + !! call display_bloub (bloub, "next bloub") + + if (.NOT. bloub%alive) then + STOP " : I HAVE READ A DEAD BLOUB" + endif + + ! check with all the previuous blobs + merged = .FALSE. + do i = 1, idx-1 + if (.NOT. les_bloubs(i)%alive) then + ! print *, "dead bloub at ", i, " on ", idx + ! call display_bloub(les_bloubs(i), "DEAD ? WTF ?") + cycle + endif + + rval = distance_of_bloubs(les_bloubs(i), bloub) + + if (rval .LT. (les_bloubs(i)%radius + bloub%radius)) then + print *, "contact : ", i, idx, rval + call merge_two_bloubs(les_bloubs(i), bloub, newbloub) + les_bloubs(i)%alive = .FALSE. + nbr_merge = nbr_merge + 1 + merged = .TRUE. + endif + + enddo + if (merged) then + ! put new bloub in the list + les_bloubs(idx) = newbloub + else + ! put old bloub in the list + les_bloubs(idx) = bloub + endif + + idx = idx + 1 + + ! print *, "idx = ", idx + + enddo ! end of infinit... WHAT? + +! --------------- is the job done ? + + close(inu) ; close(outu) + + write(0, '()') + write(0, '(I5, A)') nbr_merge, " merges" + write(0, '(A)') "--- mergebloubs . . . . . . . [done]" + +! -------------------------------------------------------------- +contains + + subroutine merge_two_bloubs(bla, blb, blr) + type(t_bloubs), intent(in) :: bla, blb + type(t_bloubs), intent(out) :: blr + + blr%nick = "newbie " + 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 + + blr%radius = (bla%radius + blb%radius) / 1.414 + blr%age = min(bla%age, blb%age) + + ! bring it to life ! + blr%alive = .TRUE. + + end subroutine + +end program + +