making spagetti code

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 $< $@

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
+
+