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