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

better flashy mandelbrot set

Browse Source
This commit is contained in:
tTh
2022-12-30 02:06:00 +01:00
parent e099b398f3
commit 77ea714b19
2 changed files with 29 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
Fraktalism/fraktals.f90
View File

@@ -5,6 +5,11 @@ module fraktals
implicit none
contains
!===============================================================
!-
! Enfin un debut de Mandelbrot :)
!-
!===============================================================
! nouveau 28 mai 2022 (again)
! source:
@@ -12,18 +17,13 @@ module fraktals
!
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) / 12.3456789
@@ -33,20 +33,19 @@ subroutine parasites_0(pic, cx, cy, maxiter)
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) = mod(int(fx * fy * coef * 1.005), 250)
else
pic(ix, iy) = mod(int(fx * fy * coef), 250)
endif
enddo
enddo
end subroutine parasites_0
!===============================================================
!-
! some problems with color mapping, need more work
!-
subroutine simple_julia(pic, cx, cy, maxiter)
implicit none
integer, intent(inout), dimension (:,:) :: pic
@@ -72,22 +71,17 @@ subroutine simple_julia(pic, cx, cy, maxiter)
fx = (float(ix) / (float(width)/4.0) - 2.0)
do iy = 1, height
fy = (float(iy) / (float(height)/4.0) - 2.0)
! ------ traitement du pixel
iter = 0 ; over_iter = .FALSE.
Z = complex(fx, fy)
do while (modulus2(Z) .LT. 4.0)
Z = (Z * Z) + C
iter = iter + 1
if (iter .GE. maxiter) then
over_iter = .TRUE.
exit
endif
end do
if (over_iter) then
pic(ix, iy) = 0
else
@@ -98,22 +92,18 @@ subroutine simple_julia(pic, cx, cy, maxiter)
end subroutine simple_julia
!===============================================================
!-
! d'après les pages 91/92 du livre de Roger T Stevens
! "Fractal programming in C"
!
! "Fractal programming in C"
!-
subroutine compute_pickover(array, coefs)
type(t_point3d), dimension(:) :: array
double precision, dimension(4) :: coefs
double precision :: xa, ya, za, xb, yb, zb
integer :: i
! print *, "coefs ", coefs
! write(0, '(1X, A18, I9)') "compute pickover ", ubound(array, 1)
xa = 1.0 ; ya = 1.0 ; za = 1.0
do i=1, ubound(array, 1)
xb = sin(coefs(1)*ya) - za*cos(coefs(2)*xa)
yb = za*sin(coefs(3)*xa) - cos(coefs(4)*ya)
@@ -126,7 +116,6 @@ subroutine compute_pickover(array, coefs)
enddo
end subroutine
!-----------------------------------------------------
!
! d'après les pages 91/92 du livre de Roger T Stevens
@@ -190,7 +179,8 @@ end subroutine lorentz_0
!===============================================================
! -- some support functions --
!-----------------------------------------------------------
! usage : evolvopick & voxelize
! usage in : evolvopick & voxelize
!-
subroutine interp4dp (ina, inb, out, dpk)
double precision, dimension(4), intent(in) :: ina, inb
double precision, dimension(4), intent(out) :: out