big commit before big mess

BloubWorld/bloubspace.f90

@@ -293,7 +293,6 @@ module bloubspace
   end subroutine
   ! ----------------------------------------------------------------
 
-
 end module
 
 

BloubWorld/listbloubs.f90

@@ -18,12 +18,13 @@ program movebloubs
   call getarg(1, infile)
 
   write (0, '(A)') &
-            "*** listing bloubs from "//trim(infile)
+            "***** listing bloubs from "//trim(infile)
 
   allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
   if (0 .NE. errcode) then
     STOP " : NO ENOUGH MEMORY"
   endif
+  ! run a molly-guard
   do i = 1, NB_MAX_BLOUBS
     bloubs(i)%alive = .FALSE.
   enddo
@@ -31,7 +32,7 @@ program movebloubs
   call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot)
   write(0, '(A,I6,1X,A)') "slurped ", nbgot, "bloubs"
 
-  do i=1,nbgot
+  do i=1, nbgot
     write(6, '(A8, 1X, 1L, 1X, I2, 3X, F8.3, 3X, 3F8.3, 3X, 3F8.3, 1X, I4)')  &
           bloubs(i)%nick, bloubs(i)%alive,               &
           bloubs(i)%state,                               &

BloubWorld/runme.sh

@@ -74,6 +74,7 @@ do
 	# mv ${BLBS_OUT} ${BLBS_IN}
 
 	echo
+	sleep 90
 
 done
 

Fraktalism/.gitignore

@@ -7,6 +7,7 @@ evolvopick
 henon
 essai
 
+frames/*
 WS/*.dat
 WS/*.txt
 WS/*.inc

Fraktalism/Makefile

@@ -11,10 +11,14 @@ mods/spitpgm.o:		mods/spitpgm.f90 Makefile
 mods/points3d.o:	mods/points3d.f90 Makefile
 	gfortran $(GFOPT) -c $< -o $@
 
+mods/xperiment.o:	mods/xperiment.f90 Makefile
+	gfortran $(GFOPT) -c $< -o $@
+
 fraktals.o:	fraktals.f90 Makefile
 	gfortran $(GFOPT) -c $<
 
-OBJS  = mods/spitpgm.o mods/points3d.o fraktals.o 
+OBJS  = mods/spitpgm.o mods/points3d.o mods/xperiment.o 	\
+	fraktals.o 
 
 # ---------------------------------------------
 

Fraktalism/README.md

@@ -8,8 +8,8 @@ qui montre ma première expérience dans ce domaine.
 
 ## La technique
 
-Le gros des calculs de fractales est fait dans XXX, et la gestion
+Le gros des calculs de fractales est fait dans `mods/fraktals.f90`,
-des pixels 'physiques' est fait dans YYY
+et la gestion des pixels 'physiques' est fait dans `mods/spitpgm`.
 
 Les fonctions d'usage général sont dans
 [mods/](répertoire mods/) ave trop peu

Fraktalism/essai.f90

@@ -1,9 +1,36 @@
 !-----------------------------------------------------
 program essai
+
   use spitpgm
+  use fraktals
+  use points3d
+  use xperiment
 
   implicit none
 
+  integer, dimension(:,:), allocatable    ::    picz
+  integer                                 ::    W, H, foo
+  integer                                 ::    errcode
+  character(200)                          ::    filename
+  real                                    ::    kx, ky
+
+  write(0, *) "============= essai =============="
+
+  W = 320     ;       H = 240
+
+  call srand(666)
+
+  allocate(picz(W,H), stat=errcode)
+
+  do foo=1, 360
+    write (filename, "(a, i5.5, a)") "frames/popcorn/", foo, ".pnm"
+    write(0, *) "-------->", trim(filename), "<"
+    kx   = 50.0 * sin(real(foo)*25.133)
+    ky   = 50.0 * cos(real(foo)*25.133)
+    write(0, *) foo, kx, ky
+    call parasites_0(picz, kx, ky, 233)
+    call spit_as_pgm_8(picz, trim(filename))
+  enddo
 
 !-----------------------------------------------------
 end program

Fraktalism/fraktals.f90

@@ -3,12 +3,51 @@ module fraktals
   use points3d
 
   implicit none
-!-----------------------------------------------------
-
-!-----------------------------------------------------
   contains
 
-!-----------------------------------------------------
+!===============================================================
+!	nouveau 28 mai 2022 (again) 
+! source:
+!    Fractal Creation with FRACTINT
+!
+subroutine parasites_0(pic, cx, cy, maxiter)
+    implicit none
+
+    ! here is the wtf
+    integer, intent(inout), dimension (:,:)  ::  pic
+
+    real, intent(in)                         ::  cx, cy
+    integer, intent(in)                      ::  maxiter
+
+    integer      ::  ix, iy, width, height
+    real         ::  fx, fy, coef
+    logical      ::  burps
+    ! write(0, *) "subroutine parasites_0" , maxiter
+    ! write(0, *) "constantes", cx, cy
+ 
+    width  = ubound(pic, 1)    ;    height = ubound(pic, 2)
+    coef   = float(maxiter)
+
+    do ix = 1, width
+      fx = cx + (float(ix) / (float(width)/4.0) - 2.0)
+      burps = (RAND() .lt. 0.01)
+      do iy = 1, height
+        fy = cy + (float(iy) / (float(height)/4.0) - 2.0)
+
+        if (burps) then
+          pic(ix, iy) = int(fx * fy * coef * 1.005)
+        else
+          pic(ix, iy) = int(fx * fy * coef)
+        endif
+
+      enddo
+    enddo
+
+end subroutine parasites_0
+
+
+!===============================================================
+
 subroutine simple_julia(pic, cx, cy, maxiter)
     implicit none
     integer, intent(inout), dimension (:,:)  ::  pic
@@ -59,8 +98,8 @@ subroutine simple_julia(pic, cx, cy, maxiter)
     enddo        ! ix
 
 end subroutine simple_julia
-!-----------------------------------------------------
+!===============================================================
-! 
+ 
 !  d'après les pages 91/92 du livre de Roger T Stevens
 !       "Fractal programming in C"
 ! 
@@ -130,7 +169,7 @@ subroutine plot_pickover(pic, count)
 
 end subroutine plot_pickover
 
-!-----------------------------------------------------
+!===============================================================
 ! 
 !  d'après les pages NN/NN du livre de Roger T Stevens
 !       "Fractal programming in C"
@@ -144,15 +183,15 @@ subroutine lorentz_0(pic, count)
 ! XXX    double precision      :: ka, kb, kc, kd
 ! XXX    integer               :: i, w, h, px, py
 
-
+   write(0, *) "proc lorentz_0, count is ", count
 
 end subroutine lorentz_0
 
-!-----------------------------------------------------------
+!===============================================================
 !           -- some support functions --
 !-----------------------------------------------------------
 !       usage : evolvopick & voxelize
-  subroutine interp4dp (ina, inb, out, dpk)
+subroutine interp4dp (ina, inb, out, dpk)
     double precision, dimension(4), intent(in)   :: ina, inb
     double precision, dimension(4), intent(out)  :: out
     double precision, intent(in)                 :: dpk
@@ -162,7 +201,7 @@ end subroutine lorentz_0
       out(foo) = (ina(foo) * (1.0-dpk)) + (inb(foo) * (dpk))
     enddo
 
-  end subroutine
+end subroutine
 !-----------------------------------------------------------
 
 function dist0 (x, y)

Fraktalism/mkvoxvidz.sh

@@ -57,7 +57,7 @@ do
 	grep 'Parse Time' WS/toto.err
 	grep 'Trace Time' WS/toto.err
 
-	echo ; sleep 10
+	echo 
 
 done
 

Fraktalism/mods/documention.md

@@ -2,8 +2,10 @@
 
 ## Points 3d
 
+Bientôt les quaternions ?
 
 ## Portable Net Map
 
-.pgm
+Fichiers de type `PGM` utilisés ici en version 16 bits, donc
+65536 niveaux de gris.
 

Fraktalism/mods/points3d.f90

@@ -49,7 +49,8 @@ subroutine write_points3d(array, start, length, fname)
     open(newunit=io, file=fname)
     do i = 1, length
        j = i + start
-       write(io, '(3F12.6)') array(j)%x, array(j)%y, array(j)%z
+       write(io, '(3F12.6, I8)')           &
+             array(j)%x, array(j)%y, array(j)%z, array(j)%seq
     enddo
     close(io)
 

Fraktalism/mods/xperiment.f90

@@ -0,0 +1,65 @@
+module xperiment
+
+  implicit none
+  contains
+
+!===============================================================
+! nouveau 24 mai 2022
+
+subroutine parasites_0(pic, cx, cy, maxiter)
+    implicit none
+
+    ! here is the wtf
+    integer, intent(inout), dimension (:,:)  ::  pic
+
+    real, intent(in)                         ::  cx, cy
+    integer, intent(in)                      ::  maxiter
+
+    integer      ::  ix, iy, width, height
+    real         ::  fx, fy, coef
+    logical      ::  burps
+    ! write(0, *) "subroutine parasites_0" , maxiter
+    ! write(0, *) "constantes", cx, cy
+ 
+    width  = ubound(pic, 1)    ;    height = ubound(pic, 2)
+    coef   = float(maxiter)
+
+    do ix = 1, width
+      fx = cx + (float(ix) / (float(width)/4.0) - 2.0)
+      burps = (RAND() .lt. 0.01)
+      do iy = 1, height
+        fy = cy + (float(iy) / (float(height)/4.0) - 2.0)
+
+        if (burps) then
+          pic(ix, iy) = int(fx * fy * coef * 1.005)
+        else
+          pic(ix, iy) = int(fx * fy * coef)
+        endif
+
+      enddo
+    enddo
+
+end subroutine parasites_0
+
+!---------------------------------------------------------------
+!
+!    aucune idee de l'utilisation de ce truc !
+!
+subroutine loop_of_parasites_0(nbre, mode)
+    implicit none
+    integer, intent(in)       :: nbre, mode
+
+    integer                   :: idx
+
+    if (mode .NE. 0)  STOP "BAD MODE"
+
+    do idx = 0, nbre
+
+      write(0, *) "popcorn loop ", idx
+
+    enddo
+
+end subroutine loop_of_parasites_0
+
+!===============================================================
+end module xperiment

Fraktalism/voxelize.f90

@@ -9,7 +9,7 @@ program voxelize
 
   implicit none
 
-  integer, parameter                          :: DIMC = 180
+  integer, parameter                          :: DIMC = 320
   integer, dimension(:,:,:), allocatable      :: cube
   type(t_point3d), dimension(:), allocatable  :: points
   integer                                     :: errcode, foo, argc
@@ -35,7 +35,7 @@ program voxelize
     STOP " : NO ENOUGH MEMORY FOR CUBE"
   endif
 
-  nbr_points = 7000000
+  nbr_points = 9000000
   allocate(points(nbr_points), stat=errcode)
   if (0 .NE. errcode) then
     STOP " : NO ENOUGH MEMORY FOR POINTS"

RandomStuff/Makefile

@@ -1,14 +1,22 @@
 #
-# Fortraneries by tTh - 
+# Fortraneries by tTh - Random Stuff
 #
 
+GFOPT = -Wall -Wextra -g -time
+
 all:		essai displaykinds
 
 # -----------------------------------------------------
 
-essai:		essai.f90 Makefile
+mathstuff2.o:	mathstuff2.f90 Makefile
-	gfortran -Wall $< -o $@
+	gfortran $(GFOPT) -c $<
+
+# -----------------------------------------------------
+
+essai:		essai.f90 Makefile mathstuff2.o
+	gfortran $(GFOPT) $< mathstuff2.o -o $@
 
 displaykinds:	displaykinds.f90 Makefile
-	gfortran -Wall $< -o $@
+	gfortran $(GFOPT) $< -o $@
 
+# -----------------------------------------------------

RandomStuff/displaykinds.f90

@@ -1,5 +1,5 @@
 program displaykinds
 
-        print *, "display all kind's variants"
+        print *, "--- display all kind's variants ---"
 
 end program

RandomStuff/essai.f90

@@ -1,5 +1,21 @@
 program essai
 
-        print *, "essai"
+  use mathstuff2
+  implicit none
+
+  integer                     :: foo, bar
+  real                        :: quux
+  double precision            :: somme
+
+  write(0, *)   "----------------- essai -------------------"
+
+  call init_random_seed()           ! in module 'mathstuff'
+  somme = 0.0
+  do foo=1, 500
+    quux = rand() + rand()
+    somme = somme + quux
+    bar = mod(irand(), 7)
+    print *, foo, quux, somme/foo, bar
+  enddo
 
 end program

RandomStuff/mathstuff2.f90

@@ -0,0 +1,33 @@
+module mathstuff2
+
+! XXX This module was a copy of mathstuff.f90 fromthe BloubWorld
+! XXX                wil be moved in an other place some day...
+
+  implicit none
+  contains
+
+  ! ----------------------------------------------------------------
+  !   really quick'n'dirty hack
+  !                  not really tested yet...
+
+  subroutine init_random_seed()
+
+    integer, dimension(3) :: tarray
+    integer               :: t3, foo
+    real                  :: dummy
+    call itime(tarray)
+    t3 = 3600*tarray(1) + 60*tarray(2) + tarray(3)
+    ! write(0, '(A,3I3,A,I6)') "sranding: ", tarray, " --> ", t3
+    call srand(t3)
+
+    ! after initializing the random generator engine,
+    ! you MUST use it for initializing the initializer
+    do foo=1, tarray(1)+5
+      dummy = rand()
+    enddo
+
+  end subroutine 
+
+  ! ----------------------------------------------------------------
+end module mathstuff2
+