encore une étape pleine de bugs ?

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%py = 3.70 * (rand() - 0.50)
-    blb%pz = 4.51 * (rand() - 0.50)
+    blb%px = 3.57 * (rand() - 0.50)
+    blb%py = 2.66 * (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
+  end subroutine slurp_bloubs_file_in_array
   ! ----------------------------------------------------------------
   !        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
-    if (-4.99 .gt. (blb%py + blb%radius)) then
+    ! vertical axe Y
+    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