next up previous index
Next: Parallel Execution Up: Fields Previous: Diffusion Equation

Fortran Shifts

The following trivial F90 (and HPF at the same time) program implements Jacobi iterations for a square hot plate:          

program jacobi

  implicit none

!hpf$ nosequence

  integer, parameter :: n = 20, iterations = 200
  integer, dimension(n), parameter :: north_boundary = 1, &
       east_boundary = 40, west_boundary = 40, south_boundary = 70
  integer, dimension(n, n) :: field = 3
  logical, dimension(n, n) :: mask = .true.
  integer :: i

!hpf$ align mask(:,:) with field
!hpf$ distribute (*, block) :: field

  field(ubound(field, dim=1), :) = east_boundary
  mask(ubound(mask, dim=1), :) = .false.
  field(lbound(field, dim=1), :) = west_boundary
  mask(lbound(mask, dim=1), :) = .false.
  field(:, ubound(field, dim=2)) = north_boundary
  mask(:, ubound(mask, dim=2)) = .false.
  field(:, lbound(field, dim=2)) = south_boundary
  mask(:, lbound(mask, dim=2)) = .false.

  call print_matrix(field)

  do i = 1, iterations
     where (mask)
        field = (eoshift(field, 1, dim=1) + eoshift(field, -1, dim=1) &
             + eoshift(field, 1, dim=2) + eoshift(field, -1, dim=2)) * 0.25
     end where
  end do

  call print_matrix(field)

contains

  subroutine print_matrix(field)
    integer, dimension(:,:) :: field
    integer :: i
    write(*, '(1x)')
    do i = size(field, dim=1), 1, -1
       write(*, '(1x, 20i3)') field(:,i)
    end do
  end subroutine print_matrix

end program jacobi

Here's what the output of this program looks like:

gustav@blanc:../src 14:42:50 !610 $ ./jacobi

   1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  40  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3  3 40
  70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70

   1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1
  40 18  9  4  2  1  1  1  1  1  1  1  1  1  1  2  4  9 18 40
  40 24 14  7  3  1  1  1  1  1  1  1  1  1  1  3  7 14 24 40
  40 26 16  9  4  2  1  1  1  1  1  1  1  1  2  4  9 16 26 40
  40 27 17 10  5  2  1  1  1  1  1  1  1  1  2  5 10 17 27 40
  40 28 18 11  6  3  1  1  1  1  1  1  1  1  3  6 11 18 28 40
  40 29 19 12  7  3  1  1  1  1  1  1  1  1  3  7 12 19 29 40
  40 29 20 13  7  3  1  1  1  1  1  1  1  1  3  7 13 20 29 40
  40 29 20 13  7  3  1  1  1  1  1  1  1  1  3  7 13 20 29 40
  40 29 20 13  7  3  1  1  1  1  1  1  1  1  3  7 13 20 29 40
  40 30 21 14  8  4  2  1  1  1  1  1  1  2  4  8 14 21 30 40
  40 30 22 15 10  6  4  2  1  1  1  1  2  4  6 10 15 22 30 40
  40 31 23 17 13  9  6  4  3  3  3  3  4  6  9 13 17 23 31 40
  40 32 25 20 16 13 10  8  7  7  7  7  8 10 13 16 20 25 32 40
  40 33 28 24 21 18 16 14 13 13 13 13 14 16 18 21 24 28 33 40
  40 35 32 29 27 25 23 22 21 21 21 21 22 23 25 27 29 32 35 40
  40 38 37 36 35 34 32 31 31 31 31 31 31 32 34 35 36 37 38 40
  40 43 45 45 45 44 43 42 42 42 42 42 42 43 44 45 45 45 43 40
  40 52 55 56 56 56 56 55 55 55 55 55 55 56 56 56 56 55 52 40
  70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70 70
gustav@blanc:../src 14:42:56 !611 $



Zdzislaw Meglicki
2001-02-26