Fortraneries/Fraktalism/fraktals.f90

66 lines
1.6 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-12 21:00:57 +01:00
width = ubound(pic, 1)
height = ubound(pic, 2)
2022-02-12 23:27:59 +01:00
! print *, "image size : ", width, height
2022-02-12 21:00:57 +01:00
! print *, "constante : ", cx, cy
C = complex(cx, cy)
2022-02-12 23:27:59 +01:00
! print *, "C = ", 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
iter = 0
Z = complex(fx, fy)
do while ( (modulus2(Z) .LT. 4.0) .AND. &
(iter < maxiter) )
Z = (Z * Z) + C
iter = iter + 1
end do
pic(ix, iy) = iter
! print *, ix, iy, " ", fx, fy, " ", iter
enddo
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