encore une étape pleine de bugs ?

BloubWorld/mergebloubs.f90

@@ -7,14 +7,15 @@ program mergebloubs
   use bloubspace
   implicit none
 
-  integer, parameter       :: NB_MAX_BLOUBS = 25000
+  integer, parameter       :: NB_MAX_BLOUBS = 250000
 
   character(200)           :: infile, outfile
-  type(t_bloubs)           :: bloub, newbloub
-  integer                  :: inu, outu, errcode
-
-  type(t_bloubs), dimension(:), allocatable  :: les_bloubs
-
+  ! 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
@@ -23,13 +24,42 @@ program mergebloubs
   call getarg(1, infile)
   call getarg(2, outfile)
 
-  write(0, '(A, 2A20, I8)') "*** mergebloubs ",        &
+  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
 
-  STOP '[done]'
+  call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot)
+  write(0, '(A,I6,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.
+      endif
+
+    enddo
+  enddo
+
+  call spit_bloubs_to_file (outfile, bloubs, nbgot)
+  print *, contacts, "contacts pour ", nbgot, "bloubs"
+
+  ! STOP 'mergebloubs [done]'
+
+! ==============================================================
 
-! --------------------------------------------------------------
 contains
 
   subroutine merge_two_bloubs(bla, blb, blr)
@@ -47,7 +77,7 @@ contains
       blr%vy = (bla%vy + blb%vy) / 2.0
       blr%vz = (bla%vz + blb%vz) / 2.0
 
-      blr%radius = (bla%radius + blb%radius) / 2.718
+      blr%radius = (bla%radius + blb%radius) / 2.222
       blr%age = min(bla%age, blb%age)
 
       ! bring it to life !