158 lines
4.5 KiB
Fortran
158 lines
4.5 KiB
Fortran
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
|
|
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
|
|
|
|
width = ubound(pic, 1) ; height = ubound(pic, 2)
|
|
coef = float(maxiter) / 12.3456789
|
|
|
|
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) = 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
|
|
!===============================================================
|
|
!-
|
|
! d'après les pages 91/92 du livre de Roger T Stevens
|
|
! "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
|
|
|
|
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)
|
|
zb = sin(xa)
|
|
array(i)%x = xb
|
|
array(i)%y = yb
|
|
array(i)%z = zb
|
|
array(i)%seq = i
|
|
xa = xb ; ya = yb ; za = zb
|
|
enddo
|
|
|
|
end subroutine
|
|
!-----------------------------------------------------
|
|
!
|
|
! d'après les pages 91/92 du livre de Roger T Stevens
|
|
! "Fractal programming in C"
|
|
!
|
|
subroutine plot_pickover(pic, count)
|
|
implicit none
|
|
integer, intent(inout), dimension (:,:) :: pic
|
|
integer, intent(in) :: count
|
|
|
|
type(t_point3d), dimension(:), allocatable :: points
|
|
double precision, dimension(4) :: coefs
|
|
integer :: i, w, h, px, py, errcode
|
|
|
|
write(0, '(1X, A18 , I9)') "pickover_0 ", count
|
|
|
|
allocate(points(count), stat=errcode)
|
|
if (0 .NE. errcode) then
|
|
STOP " : NO ENOUGH MEMORY"
|
|
endif
|
|
|
|
! Clear the picture
|
|
pic = 0
|
|
|
|
coefs(1) = 2.24 ; coefs(2) = 0.43
|
|
coefs(3) = -0.65 ; coefs(4) = -2.43
|
|
call compute_pickover(points, coefs)
|
|
|
|
w = ubound(pic, 1)
|
|
h = ubound(pic, 2)
|
|
|
|
do i=1, ubound(points, 1)
|
|
px = int((points(i)%x * (w/4.09)) + (w / 2))
|
|
py = int((points(i)%y * (h/4.09)) + (h / 2))
|
|
pic(px, py) = 255 ! WARNING COREDUMP ?
|
|
enddo
|
|
|
|
deallocate(points)
|
|
|
|
end subroutine plot_pickover
|
|
|
|
!===============================================================
|
|
!
|
|
! d'après les pages NN/NN du livre de Roger T Stevens
|
|
! "Fractal programming in C"
|
|
!
|
|
subroutine lorentz_0(pic, count)
|
|
implicit none
|
|
integer, intent(inout), dimension (:,:) :: pic
|
|
integer, intent(in) :: count
|
|
|
|
! XXX double precision :: xa, ya, za, xb, yb, zb
|
|
! XXX double precision :: ka, kb, kc, kd
|
|
! XXX integer :: i, w, h, px, py
|
|
|
|
write(0, *) "lorentz_0, picz is ", ubound(pic)
|
|
write(0, *) "lorentz_0, count is ", count
|
|
|
|
end subroutine lorentz_0
|
|
|
|
!===============================================================
|
|
! -- some support functions --
|
|
!-----------------------------------------------------------
|
|
! 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
|
|
double precision, intent(in) :: dpk
|
|
integer :: foo
|
|
|
|
do foo=1, 4
|
|
out(foo) = (ina(foo) * (1.0-dpk)) + (inb(foo) * (dpk))
|
|
enddo
|
|
|
|
end subroutine
|
|
!-----------------------------------------------------------
|
|
|
|
function dist0 (x, y)
|
|
implicit none
|
|
real, intent(in) :: x, y
|
|
real :: dist0
|
|
dist0 = ( x*x + y*y )
|
|
end function
|
|
|
|
!-----------------------------------------------------------
|
|
function modulus2(pt)
|
|
implicit none
|
|
complex, intent(in) :: pt
|
|
real :: modulus2
|
|
modulus2 = real(pt)*real(pt) + imag(pt)*imag(pt)
|
|
end
|
|
!-----------------------------------------------------
|
|
|
|
end module fraktals
|