source code
! The Computer Language Benchmarks Game
! http://benchmarksgame.alioth.debian.org/
!
! contributed by George R. Gonzalez
! fixed by Simon Geard
program mandelbrot
IMPLICIT NONE
INTEGER, PARAMETER :: WantedPrecision = 8, Iterations = 50
INTEGER :: w, h, Len, i
INTEGER :: y, x, LenOut, row
REAL( WantedPrecision ) :: limit, limit2
REAL( WantedPrecision ) :: rx, ry, rw, rh
REAL( WantedPrecision ) :: Zr, Zi, Cr, Ci, Tr, Ti
REAL( WantedPrecision ) :: zero, one, v1p5, two
CHARACTER(10) :: NUM
INTEGER(1), ALLOCATABLE, DIMENSION( : ) :: OUTA
INTEGER :: OUTP, OUTB, OutUnit
INTEGER(1), ALLOCATABLE, DIMENSION( : ) :: OutBuf
INTEGER(1) :: B
LOGICAL :: Ans
CONTINUE
OutUnit = 6
Call GetArg( 1, NUM )
READ( NUM, *, END = 100 ) w; h = w; rw = w; rh = h
Len = w * h
ALLOCATE( OUTA ( Len ) )
OUTA = 0
OUTB = 0;
limit = 2.0; limit2 = limit * limit
IF( w < 1000 ) THEN
WRITE( UNIT = OutUnit, FMT = "( 'P4', /, I3, 1X, I3 )" ) w, h
ELSE
WRITE( UNIT = OutUnit, FMT = "( 'P4', /, I4, 1X, I4 )" ) w, h
ENDIF
DO y = 0,h-1
ry = y
DO x = 0,w-1
rx = x;
Zr = 0.0;Zi = 0.0;Tr = 0.0;Ti = 0.0;
Cr = 2.0 * rx / rw - 1.5
Ci = 2.0 * ry / rh - 1.0
Ans = .TRUE.
i = 0;
OUTB = OUTB + 1
DO WHILE( i < Iterations .AND. Ans )
Zi = 2.0 * Zr * Zi + Ci
Zr = Tr - Ti + Cr
Ti = Zi * Zi
Tr = Zr * Zr
i = i + 1
Ans = Tr + Ti <= limit2
END DO
IF( Ans ) OUTA( OUTB ) = 1;
END DO
END DO
LenOut = Len / 8 + 10 + h;
ALLOCATE( OutBuf( LenOut ) )
I = 0; OUTP = 0; B = 0; row = 0
DO WHILE( I < OUTB )
I = I + 1
B = ISHFT( B, 1 ) + OUTA( I )
row = row + 1
IF( IAND( I, 7 ) == 0 ) THEN
OUTP = OUTP + 1
OutBuf( OUTP ) = B;
B = 0
ELSEIF( row >= w - 1 ) THEN
OUTP = OUTP + 1
DO WHILE( IAND( I, 7 ) /= 0 )
B = ISHFT( B, 1 )
I = I + 1
END DO
OutBuf( OUTP ) = B;
B = 0
row = 0
ENDIF
ENDDO
WRITE( OutUnit, FMT = "(10000000A1)" , advance='no') ( OutBuf(I),I=1,OUTP )
100 CONTINUE
end program mandelbrot