Skip to content
Snippets Groups Projects
Verified Commit 7ff4202e authored by Dorian Stoll's avatar Dorian Stoll
Browse files

zellularautomat: fortran: Initial port

parent a002f134
No related branches found
No related tags found
No related merge requests found
...@@ -8,3 +8,7 @@ trim_trailing_whitespace = true ...@@ -8,3 +8,7 @@ trim_trailing_whitespace = true
indent_style = tab indent_style = tab
max_line_length = 100 max_line_length = 100
[*.F08]
indent_style = space
indent_size = 3
project( project(
'praktikum', 'praktikum',
'c', 'c',
'fortran',
default_options: [ default_options: [
'warning_level=3', 'warning_level=3',
'buildtype=release', 'buildtype=release',
......
!
! simulate a cellular automaton with periodic boundaries (torus-like)
! OpenMP version
!
! (c) 2024 Dorian Stoll (Fortran port)
! (c) 2016 Steffen Christgau (C99 port, modularization, parallelization)
! (c) 1996,1997 Peter Sanders, Ingo Boesnach (original source)
!
! command line arguments:
! #1: Number of lines
! #2: Number of iterations to be simulated
!
program zellularautomat
use, intrinsic :: iso_c_binding
use, intrinsic :: iso_fortran_env
use omp_lib
implicit none
! Use the RNG from libc so that all programs produce the same output
interface
subroutine libc_srand(seed) bind(C, name="srand")
import :: c_int
integer(c_int), intent(in), value :: seed
end subroutine
integer(c_int) function libc_rand() bind(C, name="rand")
import :: c_int
end function
end interface
integer, parameter :: XSIZE = 1024
integer, parameter :: LINE_SIZE = XSIZE + 2
! annealing rule from ChoDro96 page 34
! the table is used to map the number of nonzero states in the neighborhood to the new state
integer(int8), dimension(10), parameter :: ANNEAL = int([0, 0, 0, 0, 1, 0, 1, 1, 1, 1], kind=int8)
call main()
contains
! ------------------------- CA utils -------------------------------- !
subroutine ca_init(lines, its)
integer, intent(out) :: lines
integer, intent(out) :: its
character(len=32) :: arg
if (command_argument_count() /= 2) then
error stop "Invalid number of arguments"
end if
call get_command_argument(1, arg)
read (arg, *) lines
call get_command_argument(2, arg)
read (arg, *) its
if (lines <= 0) then
error stop "Invalid line count!"
end if
end subroutine
! random starting configuration
subroutine ca_init_config(buf)
integer(int8), dimension(:, :), intent(inout) :: buf
integer :: x
integer :: y
call libc_srand(424243)
do y = 2, size(buf, 2) - 1
do x = 2, size(buf, 1) - 1
buf(x, y) = int(mod(libc_rand(), 2), kind=int8)
end do
end do
end subroutine
subroutine ca_report(buf)
integer(int8), dimension(:, :), intent(inout) :: buf
integer :: width
integer :: height
integer :: y
integer :: stdout
width = size(buf, 1)
height = size(buf, 2)
do y = 1, height
buf(1, y) = 0
buf(width, y) = 0
end do
! Dump raw, unformatted data to stdout
open (newunit=stdout, file="/dev/stdout", access='stream', action='write')
write (stdout) buf
close (stdout)
end subroutine
! --------------------- CA simulation -------------------------------- !
! treat torus like boundary conditions
subroutine boundary(buf)
integer(int8), dimension(:, :), intent(inout) :: buf
integer :: x, y
integer :: width, height
width = size(buf, 1)
height = size(buf, 2)
!$omp sections
!$omp section
!$omp parallel do
do y = 1, height
! copy rightmost column to the buffer column 1
buf(1, y) = buf(width - 1, y)
! copy leftmost column to the buffer column width
buf(width, y) = buf(2, y)
end do
!$omp end parallel do
!$omp section
!$omp parallel do
do x = 1, width
! copy bottommost row to buffer row 1
buf(x, 1) = buf(x, height - 1)
! copy topmost row to buffer row height
buf(x, height) = buf(x, 2)
end do
!$omp end parallel do
!$omp end sections
end subroutine
! a: pointer to array; x,y: coordinates; result: n-th element of anneal,
! where n is the number of neighbors
integer(int8) function transition(a, x, y)
integer(int8), dimension(:, :), intent(in) :: a
integer, intent(in) :: x
integer, intent(in) :: y
transition = ANNEAL(sum(a(x - 1:x + 1, y - 1:y + 1)) + 1)
end function
! make one simulation iteration.
! old configuration is in from, new one is written to to.
subroutine simulate(from, to)
integer(int8), dimension(:, :), intent(in) :: from
integer(int8), dimension(:, :), intent(out) :: to
integer :: x
integer :: y
!$omp parallel do
do y = 2, size(from, 2) - 1
do x = 2, size(from, 1) - 1
to(x, y) = transition(from, x, y)
end do
end do
!$omp end parallel do
end subroutine
! --------------------- main routine --------------------------------- !
subroutine main()
integer(int8), allocatable, dimension(:, :) :: from
integer(int8), allocatable, dimension(:, :) :: to
integer(int8), allocatable, dimension(:, :) :: tmp
integer :: lines
integer :: its
integer :: i
call ca_init(lines, its)
allocate (from(LINE_SIZE, lines + 2))
allocate (to(LINE_SIZE, lines + 2))
call ca_init_config(from)
do i = 1, its
call boundary(from)
call simulate(from, to)
tmp = from
from = to
to = tmp
end do
call ca_report(from(:, 2:lines + 1))
deallocate (from)
deallocate (to)
end subroutine
end program zellularautomat
sources = [
'main.F08',
]
dependencies = [
dependency('openmp'),
]
options = [
'fortran_std=f2008',
]
executable(
'zellularautomat-fortran',
sources,
dependencies: dependencies,
override_options: options,
)
subdir('c') subdir('c')
subdir('fortran')
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment