tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

big commit before big mess

Browse Source
This commit is contained in:
tth 2022-10-28 21:53:57 +02:00
parent 7cde5e3b6b
commit 23f3eeb032
17 changed files with 225 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
BloubWorld/bloubspace.f90
View File

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

5
BloubWorld/listbloubs.f90
View File

@ -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, &

1
BloubWorld/runme.sh
View File

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

1
Fraktalism/.gitignore vendored
View File

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

6
Fraktalism/Makefile
View File

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

4
Fraktalism/README.md
View File

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

27
Fraktalism/essai.f90
View File

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

61
Fraktalism/fraktals.f90
View File

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

2
Fraktalism/mkvoxvidz.sh
View File

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

4
Fraktalism/mods/documention.md
View File

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

3
Fraktalism/mods/points3d.f90
View File

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

65
Fraktalism/mods/xperiment.f90 Normal file
View File

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

4
Fraktalism/voxelize.f90
View File

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

16
RandomStuff/Makefile
View File

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

2
RandomStuff/displaykinds.f90
View File

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

18
RandomStuff/essai.f90
View File

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

33
RandomStuff/mathstuff2.f90 Normal file
View File

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