Fortraneries/Fraktalism/julias.f90

98 lines
2.9 KiB
Fortran
Raw Normal View History

2023-01-02 00:28:52 +11:00
module julias
implicit none
contains
!===============================================================
!-
! some problems with color mapping, need more work
!-
subroutine simple_julia(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
2023-01-03 11:22:40 +11:00
real :: fx, fy
2023-01-02 00:28:52 +11:00
complex :: Z, C
integer :: iter
logical :: over_iter
width = ubound(pic, 1)
height = ubound(pic, 2)
C = complex(cx, cy)
print *, "Const = ", C
! ready ? ok, clear the picture
pic = 0
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 ; over_iter = .FALSE.
Z = complex(fx, fy)
do while (real(Z)*real(Z) + imag(Z)*imag(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
pic(ix, iy) = iter*12
endif
enddo ! iy
enddo ! ix
end subroutine simple_julia
!===============================================================
2023-01-03 11:22:40 +11:00
subroutine julia_colormapped(pic, cx, cy, maxiter)
use pixrgb
type(t_pixrgb), intent(inout), dimension (:,:) :: pic
real, intent(in) :: cx, cy
integer, intent(in) :: maxiter
integer :: ix, iy, width, height
real :: fx, fy
complex :: Z, C
integer :: iter
logical :: over_iter
width = ubound(pic, 1)
height = ubound(pic, 2)
C = complex(cx, cy)
print *, "Color julia, const = ", C
do ix = 1, width
fx = (float(ix) / (float(width*2)/4.0) - 1.0)
do iy = 1, height
fy = (float(iy) / (float(height*2)/4.0) - 1.0)
! ------ traitement du pixel
iter = 0 ; over_iter = .FALSE.
Z = complex(fx, fy)
do while ((real(Z)*real(Z) + imag(Z)*imag(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)%r = 0
pic(ix, iy)%g = mod(abs(int(real(Z) *140)), 255)
pic(ix, iy)%b = mod(abs(int(aimag(Z)*140)), 255)
else
pic(ix, iy)%r = mod(iter*33, 255)
pic(ix, iy)%g = mod(iter*29, 255)
pic(ix, iy)%b = mod(iter*21, 255)
endif
enddo ! iy
enddo ! ix
end subroutine
!===============================================================
2023-01-02 00:28:52 +11:00
end module