encore une étape pleine de bugs ?

BloubWorld/Makefile

@@ -31,7 +31,7 @@ out.lst:	out.blbs exportbloubs Makefile
 # ------------------------------------------------------------
 
 bloubspace.o:	bloubspace.f90 Makefile
-	gfortran $(GFOPT) -pg -c $<
+	gfortran $(GFOPT) -c $<
 
 povstuff.o:	povstuff.f90 Makefile
 	gfortran $(GFOPT) -c $<

BloubWorld/bloubspace.f90

@@ -71,39 +71,62 @@ module bloubspace
   subroutine random_pv (blb)
     type(t_bloubs), intent (out)     :: blb
 
-    blb%px = 4.33 * (rand() - 0.50)
+    blb%px = 3.57 * (rand() - 0.50)
-    blb%py = 3.70 * (rand() - 0.50)
+    blb%py = 2.66 * (rand() - 0.50)
-    blb%pz = 4.51 * (rand() - 0.50)
+    blb%pz = 3.57 * (rand() - 0.50)
 
-    blb%vx = (rand()) / 2.000
+    blb%vx = (rand()) / 2.500
     if (blb%px .LT. 0.0) blb%vx = -blb%vx
 
-    blb%vy = (rand()) / 3.200
+    blb%vy = (rand()) / 4.000
     if (blb%py .LT. 0.0) blb%vy = -blb%vx
 
-    blb%vz = (rand()) / 2.000
+    blb%vz = (rand()) / 2.500
     if (blb%pz .LT. 0.0) blb%vz = -blb%vz
 
     blb%state  = 0
     blb%alive  = .TRUE.
     blb%age    = 0
-    blb%agemax = 500
+    blb%agemax = 300
 
   end subroutine
   ! ----------------------------------------------------------------
   !        Load a blbs file into an array of bloubs
   subroutine spit_bloubs_to_file (fname, blbarray, towrite)
-
     character(*), intent(in)       :: fname
     type(t_bloubs), dimension(:)   :: blbarray
     integer, intent(in)            :: towrite
 
-    write (0, '(" spiting", (I6), "bloubs to", (A), "file")')     &
+    integer                :: errcode, output, foo, spitted
+    character(200)         :: chaine
+ 
+    write (0, '(" spitting", (I6), " bloubs to ", (A), " file")')     &
                         towrite, trim(fname)
 
-    STOP ' : NOT IMPLEMENTED'
+    open(      newunit=output,                            &
+               file=trim(fname), form='unformatted',      &
+               iostat=errcode, iomsg=chaine,              &
+               action='write', status='replace')
+    if (0 .ne. errcode) then
+      write(0, '(" errcode ", I8, 2X, A)') errcode, chaine
+      STOP " : CAN'T OPEN FILE " // trim(fname)
+    endif
 
-  end subroutine
+    spitted = 0
+    do foo=1, towrite
+      if (blbarray(foo)%alive) then
+        write(output, iostat=errcode) blbarray(foo) 
+        if (0 .ne. errcode) then
+          STOP " : WRITE ERROR TO " // trim(fname)
+        endif
+        spitted = spitted + 1
+      endif
+    enddo
+
+    close(output)
+    write(0, '(1X, "spitted ", I6, " bloubs")') spitted 
+
+  end subroutine spit_bloubs_to_file
   ! ----------------------------------------------------------------
   !        Dump an array of bloubs to a blbs file.
   ! 
@@ -114,6 +137,7 @@ module bloubspace
 
     character(200)      :: chaine
     integer             :: input, errcode, idx
+    integer             :: capacity
     type(t_bloubs)      :: bloub
 
     write(0, '(" slurping from file [", (A), "]")') trim(infile)
@@ -128,6 +152,7 @@ module bloubspace
     endif
     ! write(0, '((A, I3))') " slurping from unit ", input
 
+    capacity = ubound(blbarray, 1)
     nbread = 0
     idx = 1;
     do
@@ -143,12 +168,15 @@ module bloubspace
         blbarray(idx) = bloub
         idx = idx + 1
       endif
+      if (idx .GT. capacity) then
+        exit
+      endif
     enddo
 
     close(input)        ! no error checking ?
+    ! write(0, '(" have read ", (I8), " bloubs")') nbread
 
-   write(0, '(" read ", (I8), " bloubs")') nbread
+  end subroutine slurp_bloubs_file_in_array
-  end subroutine
   ! ----------------------------------------------------------------
   !        Display a bloub content to stderr
 
@@ -178,7 +206,6 @@ module bloubspace
     real,           intent (in)     :: coef
 
     ! we must check that this bloub is alive ?
-
     blb%px  = blb%px + (blb%vx * coef)
     blb%py  = blb%py + (blb%vy * coef)
     blb%pz  = blb%pz + (blb%vz * coef)
@@ -189,41 +216,46 @@ module bloubspace
   !     detection des collisions avec les parois de la boite
   !     laquelle boite gagnerais beaucoup a etre parametrable.
   ! 
-  subroutine bound_a_blob (blb)
+  subroutine bound_a_bloub (blb)
     type(t_bloubs), intent (inout)  :: blb
 
-    if ( 5.0 .lt. (blb%px + blb%radius)) then
+    real, parameter      :: SH = 6.0
+    real, parameter      :: SV = 4.0
+
+    !    X axis
+    if ((blb%px + blb%radius) .GT. SH) then
       blb%vx = -1.0 * blb%vx
-      blb%px = 5.0
+      blb%px = SH- blb%radius
       blb%age = blb%age + 1
     endif
-    if (-5.0 .gt. (blb%px + blb%radius)) then
+    if ((blb%px - blb%radius) .LT. -SH) then
       blb%vx = -1.0 * blb%vx
-      blb%px = -5.0
+      blb%px = -SH + blb%radius
       blb%age = blb%age + 1
     endif
 
-    ! vertical axe
+    ! vertical axe Y
-    if (-4.99 .gt. (blb%py + blb%radius)) then
+    if ((blb%py - blb%radius) .LT. -SV) then
       blb%vy = -1.0 * blb%vy
-      blb%py = blb%radius
+      blb%py = -SV + blb%radius
       blb%age = blb%age + 1
     endif
-    if ( 4.99 .lt. (blb%py + blb%radius)) then       ! overshoot ?
+    if ((blb%py + blb%radius) .GT. SV) then       ! overshoot ?
       blb%vy = -1.0 * blb%vy
       blb%age = blb%age + 1
-      blb%py = 5.0 - blb%radius                            !!
+      blb%py = SV - blb%radius
     endif
 
-    if ( 5.0 .lt. (blb%pz + blb%radius)) then
+    !    Z axis
+    if ((blb%pz + blb%radius) .GT. SH) then
       blb%vz = -1.0 * blb%vz
       blb%age = blb%age + 1
-      blb%pz = 5.0
+      blb%pz = SH - blb%radius
     endif
-    if (-5.0 .gt. (blb%pz + blb%radius)) then
+    if ((blb%pz + blb%radius) .LT. -SH) then
       blb%vz = -1.0 * blb%vz
       blb%age = blb%age + 1
-      blb%pz = -5.0
+      blb%pz = -SH + blb%radius
     endif
 
   end subroutine
@@ -249,7 +281,7 @@ module bloubspace
   subroutine green_soylent (blb)
     type(t_bloubs), intent (inout)  :: blb
 
-    if (blb%age .gt. 18) then
+    if (blb%age .gt. 24) then
       blb%alive = .FALSE.
     endif
 

BloubWorld/genbloubs.f90

@@ -1,6 +1,7 @@
 program genbloubs
 
   use bloubspace
+  use mathstuff
 
   integer               :: nbbloubs
   integer               :: i

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
+  ! type(t_bloubs)           :: bloub, newbloub
-  integer                  :: inu, outu, errcode
+  integer                  :: errcode, nbgot
-
+  type(t_bloubs), dimension(:), allocatable  :: bloubs
-  type(t_bloubs), dimension(:), allocatable  :: les_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 !

BloubWorld/movebloubs.f90

@@ -24,7 +24,7 @@ program movebloubs
   call getarg(2, outfile)
 
   write (0, '(A)') &
-  "*** moving bloubs from "//trim(infile)//" to "//trim(outfile)
+  "### moving bloubs from "//trim(infile)//" to "//trim(outfile)
 
   open(newunit=inu,                                          &
                   file=trim(infile), form='unformatted',     &
@@ -56,17 +56,16 @@ program movebloubs
     endif
 
     ! moving, morphing and boundingboxing
-    call move_bloub    (bloub, 0.185)
+    call move_bloub     (bloub, 0.185)
-    call bound_a_blob  (bloub)
+    call bound_a_bloub  (bloub)
-    if (bloub%radius .GT. 0.0155) then
+    if (bloub%radius .GT. 0.0238) then
-      bloub%radius = bloub%radius * 0.9970
+      bloub%radius = bloub%radius * 0.996
     endif
 
     call green_soylent (bloub)
     if (.NOT. bloub%alive) then
       ! write(0, '(A)') "   KILL!"
       killed = killed  + 1
-      ! cycle   ! ???
     endif
 
     ! calcul du barycentre
@@ -74,11 +73,13 @@ program movebloubs
     by = by + dble(bloub%py)
     bz = bz + dble(bloub%pz)
 
-    write(outu, iostat=errcode) bloub     ! no error control ?
+    if (bloub%alive) then
-    if (0 .ne. errcode) then
+      write(outu, iostat=errcode) bloub   
-      STOP " : WRITE ERROR TO " // trim(outfile)
+      if (0 .ne. errcode) then
+        STOP " : WRITE ERROR TO " // trim(outfile)
+      endif
+      compteur = compteur + 1
     endif
-    compteur = compteur + 1
 
   enddo                     ! end of main loop
 
@@ -88,15 +89,15 @@ program movebloubs
 
   ! insert some fancy conditional here
   if (compteur .LT.  200) then
-    call add_more_bloubs(outu, 5, 0.1333)
+    call add_more_bloubs(outu, 4, 0.1056)
   endif
 
   ! insert some very fancy conditional here
-  if (compteur .LT. 3000) then
+  if (compteur .LT. 800) then
     rnd = rand()
     write (0, '(A,1X,F9.6)') "try to add bloubs, rnd is", rnd
-    if (rnd .LT. 0.0455) then
+    if (rnd .LT. 0.0604) then
-      call add_more_bloubs(outu, 24, 0.0999)
+      call add_more_bloubs(outu, 11, 0.099)
     endif
   endif
 
@@ -120,7 +121,7 @@ contains
   type(t_bloubs)             :: bloub
   integer                    :: foo, count
 
-  count = nbre+mod(irand(), 9)
+  count = nbre+mod(irand(), 6)
   write(0, '(A,I4,1X,A)') "adding", count, "bloubs"
 
   do foo=1, count

BloubWorld/runme.sh

@@ -10,7 +10,7 @@ TMPPNG="/dev/shm/bloubs7.png"
 POVOPT="+Q9 +a -v -d -W1600 -H1200 -WT2"
 DDIR="frames/a"
 LOGERR="log.error"
-TXTCOLOR="RosyBrown"
+TXTCOLOR="GreenYellow"
 
 # --- put the work file in ramdisk
 BLBS_IN="/dev/shm/in.blbs"
@@ -54,7 +54,7 @@ do
 
 	convert		${TMPPNG}			\
 			-font Courier-Bold		\
-			-pointsize 24			\
+			-pointsize 28			\
 			-fill "$TXTCOLOR"		\
 			-gravity south-east		\
 			-annotate +25+5 "$td"		\
@@ -62,16 +62,17 @@ do
 			-annotate +25+5 "$hi"		\
 			-pointsize 48			\
 			-gravity north-east		\
-			-annotate +25+5 "$count"	\
+			-annotate +45+5 "$count"	\
 			-gravity north-west		\
-			-annotate +25+5 "BloubWorld"	\
+			-annotate +45+5 "BloubWorld"	\
 			$PNG
 
 	echo $PNG '[done]'
 
 	./movebloubs ${BLBS_IN} ${BLBS_OUT}
-	# ./mergebloubs ${BLBS_OUT} ${BLBS_IN}
+	./mergebloubs ${BLBS_OUT} ${BLBS_IN}
-	mv ${BLBS_OUT} ${BLBS_IN}
+	# mv ${BLBS_OUT} ${BLBS_IN}
+
 	echo
 
 done

BloubWorld/scene.pov

@@ -11,8 +11,6 @@ global_settings {
 
 #include  "colors.inc"
 
-
-
 #include  "WS/nbimg.inc"
 
 #declare NormClock = clock / NbImg;
@@ -28,16 +26,16 @@ global_settings {
 
 object	{
 	Bloubs
-	finish { phong 0.55 specular 0.55 }
+	finish { phong 0.57 specular 0.57 }
 	}
 
 object {
 	union {
-		plane	{ <1, 0, 0>, -32 	}
+		plane	{ <1, 0, 0>, -37 	}
-		plane	{ <1, 0, 0>,  32	}
+		plane	{ <1, 0, 0>,  37	}
-		plane	{ <0, 1, 0>, -24	}
+		plane	{ <0, 1, 0>, -27	}
-		plane	{ <0, 1, 0>,  24	}
+		plane	{ <0, 1, 0>,  27	}
-		plane	{ <0, 0, 1>,  50 	}
+		plane	{ <0, 0, 1>,  69 	}
 
 		texture {
 			pigment { color srgb <0.125, 0.144, 0.111> } 
@@ -46,17 +44,19 @@ object {
 		}
 	}
 
+// object { cylinder { <0, 0, 0>, <10, 0, 0>, 0.05 pigment { color Cyan } } }
+
 //  ----------------------------------------------------------
 
-#declare BH = 5;		// H = taille en horizontal
+#declare BH = 6;		// H = taille en horizontal
-#declare BV = 5;		// V = taille en vertical
+#declare BV = 4;		// V = taille en vertical
-#declare BR = 0.032;
+#declare BR = 0.034;
 
 #declare Une_Borne = object
 {
 merge	{
 	cylinder { <0, BV, 0>,   <0, -BV,   0>,   BR     }
-	cylinder { <0, 0.012, 0>, <0, -0.012, 0>,   BR*4   }
+	cylinder { <0, 0.014, 0>, <0, -0.014, 0>,   BR*4   }
 	}
 }
 
@@ -75,8 +75,8 @@ pigment { color Gray40 }
 #declare Les_Bornes = object
 {
 union	{
-	#local E = 0.002;
+	#local E = 0.0015;
-	object { Un_Cadre translate  y*(BV-E)        }
+	object { Un_Cadre translate  y*(BV-E)         }
 	object { Un_Cadre translate -y*(BV-E)         }
 
 	object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue }  }
@@ -109,12 +109,12 @@ union {
 }
 //  ----------------------------------------------------------
 
-light_source { <19, -12, -17> color Gray80 }
+light_source { <19, -12+NormClock, -17> color Gray80 }
-light_source { <11,  14,   9> color Gray60 }
+light_source { <11,  14-NormClock,   9> color Gray60 }
 
 #declare XCAM = 8 - ( 15 * NormClock);
-#declare YCAM = 1 + (0.75 * NormClock);
+#declare YCAM = -1.1 + (0.95 * NormClock);
-#declare ZCAM = -17.5;
+#declare ZCAM = -13.10;
 
 #declare XLAT = Bary_X;
 #declare YLAT = Bary_Y;
@@ -126,5 +126,5 @@ camera  {
 	location   <XCAM, YCAM, ZCAM>
 	look_at    <XLAT, YLAT, ZLAT>
 	right           x*image_width/image_height
-	angle		66
+	angle		86
 	}

BloubWorld/toinc.awk

@@ -1,4 +1,6 @@
 
+#
+#    Input for this script is generated by 'exportbloubs.f90'
 #
 #            this code is (C) 2022 tTh
 #
@@ -13,9 +15,19 @@ BEGIN	{
 
 	{
 	age = $5
-	if (age < 2)		color = "Orange"
+	merged = $6
-	else if (age > 8)	color = "Gray70"
+
-	else			color = "Sienna"
+	color = "Cyan"
+	if (age < 2)		color = "Yellow"
+	if (merged) {
+		if (age > 12)	color = "Orange"
+		else		color = "Red"
+		}
+	else	{
+		if (age > 12)	color = "CadetBlue"
+		else		color = "Aquamarine"
+		}
+
 	bx += $1
 	by += $2
 	bz += $3