diff --git a/BloubWorld/bloubspace.f90 b/BloubWorld/bloubspace.f90 index 4a01154..ff99a36 100644 --- a/BloubWorld/bloubspace.f90 +++ b/BloubWorld/bloubspace.f90 @@ -293,7 +293,6 @@ module bloubspace end subroutine ! ---------------------------------------------------------------- - end module diff --git a/BloubWorld/listbloubs.f90 b/BloubWorld/listbloubs.f90 index 0f459e5..d5c1cd4 100644 --- a/BloubWorld/listbloubs.f90 +++ b/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, & diff --git a/BloubWorld/runme.sh b/BloubWorld/runme.sh index 5a2c5a4..0a0b5d8 100755 --- a/BloubWorld/runme.sh +++ b/BloubWorld/runme.sh @@ -74,6 +74,7 @@ do # mv ${BLBS_OUT} ${BLBS_IN} echo + sleep 90 done diff --git a/Fraktalism/.gitignore b/Fraktalism/.gitignore index 6ae527f..c02b080 100644 --- a/Fraktalism/.gitignore +++ b/Fraktalism/.gitignore @@ -7,6 +7,7 @@ evolvopick henon essai +frames/* WS/*.dat WS/*.txt WS/*.inc diff --git a/Fraktalism/Makefile b/Fraktalism/Makefile index aa9980a..34627a4 100644 --- a/Fraktalism/Makefile +++ b/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 # --------------------------------------------- diff --git a/Fraktalism/README.md b/Fraktalism/README.md index e3f531c..a77bb7e 100644 --- a/Fraktalism/README.md +++ b/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 -des pixels 'physiques' est fait dans YYY +Le gros des calculs de fractales est fait dans `mods/fraktals.f90`, +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 diff --git a/Fraktalism/essai.f90 b/Fraktalism/essai.f90 index d4a5dcb..89aa889 100644 --- a/Fraktalism/essai.f90 +++ b/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 diff --git a/Fraktalism/fraktals.f90 b/Fraktalism/fraktals.f90 index 6707e7c..526ee6d 100644 --- a/Fraktalism/fraktals.f90 +++ b/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) diff --git a/Fraktalism/mkvoxvidz.sh b/Fraktalism/mkvoxvidz.sh index 7be5946..6508c99 100755 --- a/Fraktalism/mkvoxvidz.sh +++ b/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 diff --git a/Fraktalism/mods/documention.md b/Fraktalism/mods/documention.md index 3eed800..aec3988 100644 --- a/Fraktalism/mods/documention.md +++ b/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. diff --git a/Fraktalism/mods/points3d.f90 b/Fraktalism/mods/points3d.f90 index a9f51c8..0118080 100644 --- a/Fraktalism/mods/points3d.f90 +++ b/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) diff --git a/Fraktalism/mods/xperiment.f90 b/Fraktalism/mods/xperiment.f90 new file mode 100644 index 0000000..2081335 --- /dev/null +++ b/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 diff --git a/Fraktalism/voxelize.f90 b/Fraktalism/voxelize.f90 index c3213cc..47b1e4a 100644 --- a/Fraktalism/voxelize.f90 +++ b/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" diff --git a/RandomStuff/Makefile b/RandomStuff/Makefile index 7ef5b1a..654d286 100644 --- a/RandomStuff/Makefile +++ b/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 - gfortran -Wall $< -o $@ +mathstuff2.o: mathstuff2.f90 Makefile + gfortran $(GFOPT) -c $< + +# ----------------------------------------------------- + +essai: essai.f90 Makefile mathstuff2.o + gfortran $(GFOPT) $< mathstuff2.o -o $@ displaykinds: displaykinds.f90 Makefile - gfortran -Wall $< -o $@ + gfortran $(GFOPT) $< -o $@ +# ----------------------------------------------------- diff --git a/RandomStuff/displaykinds.f90 b/RandomStuff/displaykinds.f90 index c73069e..12d6f8c 100644 --- a/RandomStuff/displaykinds.f90 +++ b/RandomStuff/displaykinds.f90 @@ -1,5 +1,5 @@ program displaykinds - print *, "display all kind's variants" + print *, "--- display all kind's variants ---" end program diff --git a/RandomStuff/essai.f90 b/RandomStuff/essai.f90 index a7c4ad5..a520c3e 100644 --- a/RandomStuff/essai.f90 +++ b/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 diff --git a/RandomStuff/mathstuff2.f90 b/RandomStuff/mathstuff2.f90 new file mode 100644 index 0000000..9ce2575 --- /dev/null +++ b/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 +