Anonymous user
Julia set: Difference between revisions
→{{header|Fortran}}
Line 1,380:
</pre>
'''Note''' that for images the first '''''y''''' value is the top. The call to the <code>linspace</code> procedure inverts the imaginary axis so that the set is displayed with '''''-1*i''''' at the bottom and '''''+1*i''''' at the top.
This next version generates a Portable Gray Map (PGM)<br>
{{works with|Fortran|95 and later}}
[[File:julia-set-gray.png|480px|thumb|right]]
<lang fortran>! ==============================================================================
module julia_mod
! ----------------------------------------------------------------------------
implicit none
character(*), parameter :: DEF_FSPC = 'julia.pgm'
complex(8), parameter :: DEF_SEED = (-0.798d0, 0.1618d0)
complex(8), parameter :: DEF_UL = (-1.5d0, 1.0d0)
complex(8), parameter :: DEF_LR = ( 1.5d0, -1.0d0)
integer, parameter :: NUM_COLS = 1024
integer, parameter :: NUM_ROWS = 768
contains
! ============================================================================
subroutine juliaPGM( fspc, nr, nc, ul, lr, c )
! --------------------------------------------------------------------------
implicit none
character(*), intent(in) :: fspc ! path to the PGM file
integer, intent(in) :: nr ! number of rows
integer, intent(in) :: nc ! number of columns
complex(8), intent(in) :: ul ! upper left point on complex plane
complex(8), intent(in) :: lr ! lower right point on complex plane
complex(8), intent(in) :: c ! seed
! --------------------------------------------------------------------------
real(8), allocatable :: X(:), Y(:)
integer :: un, ir, ic, i, clr
complex(8) :: z
integer, parameter :: max_cycle = 512
! --------------------------------------------------------------------------
allocate( X(nc) )
allocate( Y(nr) )
call linSpace( X, ul%RE, lr%RE )
call linSpace( Y, ul%IM, lr%IM )
open ( FILE=fspc, NEWUNIT=un, ACTION='WRITE', STATUS='REPLACE' )
write ( un, 100 )
write ( un, 110 )
write ( un, 120 ) nc, nr
write ( un, 130 )
do ir=1,nr
do ic=1,nc
z = cmplx( X(ic), Y(ir), kind=8 )
clr = 0
i = 0
do while ( i .lt. max_cycle )
z = z*z + c
if ( 2.0D0 .lt. CDABS(z) ) then
clr = modulo( i, 256 )
exit
end if
i = i + 1
end do
write ( un, 200 ) clr
end do
end do
close( un )
deallocate( Y )
deallocate( X )
100 format( 'P2' )
110 format( '# Created for Rosetta Code' )
120 format( I0,1X,I0 )
130 format( '255' )
200 format( I0 )
end subroutine juliaPGM
! ============================================================================
subroutine linSpace( A, a1, a2 )
! --------------------------------------------------------------------------
implicit none
real(8), intent(inout) :: A(:) ! array of the elements in this linear space
real(8), intent(in) :: a1 ! value of the first element
real(8), intent(in) :: a2 ! value of the last element
! --------------------------------------------------------------------------
integer :: i, n
real(8) :: delta
! --------------------------------------------------------------------------
n = size(A)
delta = (a2-a1)/real(n-1,kind=8)
A(1) = a1
do i=2,n
A(i) = A(i-1) + delta
end do
end subroutine linSpace
end module julia_mod
! ==============================================================================
program julia
! ----------------------------------------------------------------------------
use julia_mod
implicit none
call juliaPGM( DEF_FSPC, NUM_ROWS, NUM_COLS, DEF_UL, DEF_LR, DEF_SEED )
end program julia</lang>
=={{header|FreeBASIC}}==
| |||