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
Download Patch File Download Diff File Expand all files Collapse all files

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)