Fortraneries/Fraktalism/fraktals.f90

113 lines
2.7 KiB
Fortran
Raw Normal View History

2022-02-12 21:00:57 +01:00
module fraktals
implicit none
contains
!-----------------------------------------------------
2022-02-12 23:27:59 +01:00
subroutine simple_julia(pic, cx, cy, maxiter)
2022-02-12 21:00:57 +01:00
implicit none
integer, intent(inout), dimension (:,:) :: pic
real, intent(in) :: cx, cy
2022-02-12 23:27:59 +01:00
integer, intent(in) :: maxiter
2022-02-12 21:00:57 +01:00
integer :: ix, iy, width, height
real :: fx, fy
complex :: Z, C
2022-02-12 23:27:59 +01:00
integer :: iter
2022-02-14 14:15:10 +01:00
logical :: over_iter
2022-02-12 21:00:57 +01:00
width = ubound(pic, 1)
height = ubound(pic, 2)
C = complex(cx, cy)
2022-02-14 14:15:10 +01:00
print *, "Const = ", C
2022-02-12 21:00:57 +01:00
do ix = 1, width
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
2022-02-14 14:15:10 +01:00
iter = 0 ; over_iter = .FALSE.
2022-02-12 21:00:57 +01:00
Z = complex(fx, fy)
2022-02-14 14:15:10 +01:00
do while (modulus2(Z) .LT. 4.0)
2022-02-12 21:00:57 +01:00
Z = (Z * Z) + C
iter = iter + 1
2022-02-14 14:15:10 +01:00
if (iter .GE. maxiter) then
over_iter = .TRUE.
exit
endif
2022-02-12 21:00:57 +01:00
2022-02-14 14:15:10 +01:00
end do
2022-02-12 21:00:57 +01:00
2022-02-14 14:15:10 +01:00
if (over_iter) then
pic(ix, iy) = 0
else
pic(ix, iy) = iter
endif
2022-02-12 21:00:57 +01:00
enddo
enddo
2022-02-14 14:15:10 +01:00
end subroutine simple_julia
!-----------------------------------------------------
2022-02-16 00:18:35 +01:00
!
! d'après les pages 91/92 du livre de Roger T Stevens
! "Fractal programming in C"
!
2022-02-14 14:15:10 +01:00
subroutine pickover_0(pic, count)
implicit none
integer, intent(inout), dimension (:,:) :: pic
integer, intent(in) :: count
double precision :: xa, ya, za, xb, yb, zb
double precision :: ka, kb, kc, kd
2022-02-16 00:18:35 +01:00
integer :: i, w, h, px, py
2022-02-14 14:15:10 +01:00
ka = 2.24 ; kb = 0.43 ; kc = -0.65 ; kd = -2.43
xa = 0.00 ; ya = 0.00 ; za = 0.0
2022-02-16 00:18:35 +01:00
w = ubound(pic, 1)
h = ubound(pic, 2)
2022-02-14 14:15:10 +01:00
do i=1, count
xb = sin(ka*ya) - za*cos(kb*xa)
yb = za*sin(kc*xa) - cos(kd*ya)
zb = sin(xa)
2022-02-16 00:18:35 +01:00
px = (xb * (w/4.05)) + (w / 2)
py = (yb * (h/4.05)) + (h / 2)
pic(px, py) = 200 ! WARNING COREDUMP
2022-02-14 14:15:10 +01:00
2022-02-16 00:18:35 +01:00
print *, xb, yb, zb
2022-02-14 14:15:10 +01:00
xa = xb ; ya = yb ; za = zb
enddo
end subroutine pickover_0
2022-02-12 21:00:57 +01:00
!-----------------------------------------------------
2022-02-14 14:15:10 +01:00
! -- some support functions --
!-----------------------------------------------------
2022-02-12 21:00:57 +01:00
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