Appendix: Sources of the examples

This appendix shows the essential parts of all example programs. The links show the corresponding complete sources.

in main program:

  do i=1, n
     do j=1, n
        v(i) = v(i) + f(a(i,j), work)
     enddo
  enddo

loop2.f90

in main program:

  !$OMP PARALLEL
  !$OMP DO
  do i=1, n
     do j=1, n
        v(i) = v(i) + f(a(i,j), work)
     enddo
  enddo
  !$OMP END PARALLEL

pi1.f90

in main program:

  do i=1,n
     x = h*(i-0.5)
     sum = sum + 4.0 / (1.0 + x*x)
  enddo

pi2.f90

in main program:

  !$OMP PARALLEL DO
  do i=1,n
     x = h*(i-0.5)
     sum = sum + 4.0 / (1.0 + x*x)
  enddo
  !$OMP END PARALLEL DO

pi3.f90

in main program:

  !$OMP PARALLEL DO PRIVATE(x, sum)
  do i=1,n
     x = h*(i-0.5)
     sum = sum + 4.0 / (1.0 + x*x)
  enddo
  !$OMP END PARALLEL DO

pi4.f90

in main program:

  !$OMP PARALLEL DO PRIVATE(x) REDUCTION(+: sum)
  do i=1,n
     x = h*(i-0.5)
     sum = sum + 4.0 / (1.0 + x*x)
  enddo
  !$OMP END PARALLEL DO

balance1.f90

in main program:

  !$OMP PARALLEL
  !$OMP DO
  do i=1, n
     do j=i+1, n
        v(i) = v(i) + f(a(i,j), work)
     enddo
  enddo
  !$OMP END PARALLEL

balance2.f90

in main program:

  !$OMP PARALLEL
  !$OMP DO SCHEDULE(STATIC, 1)
  do i=1, n
     do j=i+1, n
        v(i) = v(i) + f(a(i,j), work)
     enddo
  enddo
  !$OMP END PARALLEL

balance3.f90

in main program:

  !$OMP PARALLEL
  !$OMP DO SCHEDULE(DYNAMIC, 1)
  do i=1, n
     do j=i+1, n
        v(i) = v(i) + f(a(i,j), work)
     enddo
  enddo
  !$OMP END PARALLEL

orphan1.f90

in smooth_x (smooth_y similar):

  do i= 2, n-1
     do j=1, n
        b(j,i) = (a(i-1,j) + f(a(i,j), work) + a(i+1,j))/3.0
     end do
  end do

in main program:

  do t=1, tmax
     call smooth_x(a, b, work)
     call smooth_y(b, a, work)
  enddo

orphan2.f90

in smooth_x (smooth_y similar):

  !$OMP DO 
  do i= 2, n-1
     do j=1, n
        b(j,i) = (a(i-1,j) + f(a(i,j), work) + a(i+1,j))/3.0
     end do
  end do
  !$OMP END DO

in main program:

  !$OMP PARALLEL
  do t=1, tmax
     call smooth_x(a, b, work)
     call smooth_y(b, a, work)
  enddo
  !$OMP END PARALLEL

orphan3.f90

in smooth_x (smooth_y similar):

  !$OMP DO 
  do i= 2, n-1
     do j=1, n
        b(j,i) = (a(i-1,j) + f(a(i,j), work) + a(i+1,j))/3.0
     end do
  end do
  !$OMP END DO NOWAIT

orphan4.f90

in main program:

  !$OMP PARALLEL
  do t=1, tmax
     call smooth_x(a, b, work)
     call smooth_y(b, a, work)
     !$OMP SINGLE
     print*, 't = ', t
     !$OMP END SINGLE
  enddo
  !$OMP END PARALLEL

section1.f90

in smooth:

  do i=2, n-1
     do j=2, n-1
        a(i,j,k) = (a(i-1,j,k) + f(a(i,j,k),work) + a(i+1,j,k) + &
                    a(i,j-1,k) + a(i,j+1,k))/5.0
     end do
  end do

in main program:

  !$OMP PARALLEL SECTIONS
  !$OMP SECTION
  call smooth(a, 1, work)
  !$OMP SECTION
  call smooth(a, 2, work)
  !$OMP SECTION
  call smooth(a, 3, work)
  !$OMP END PARALLEL SECTIONS

section2.f90

in smooth:

  !$OMP PARALLEL DO
  do i=2, n-1
     do j=2, n-1
        a(i,j,k) = (a(i-1,j,k) + f(a(i,j,k),work) + a(i+1,j,k) + &
                    a(i,j-1,k) + a(i,j+1,k))/5.0
     end do
  end do
  !$OMP END PARALLEL DO

section3.f90

in smooth:

  !$OMP PARALLEL 

  !$OMP SINGLE
  print *, 'Zahl der Threads in inner parallel loop: ',
           omp_get_num_threads()
  !$OMP END SINGLE

  !$OMP DO
  do i=2, n-1
     do j=2, n-1
        a(i,j,k) = (a(i-1,j,k) + f(a(i,j,k),work) + a(i+1,j,k) + &
                    a(i,j-1,k) + a(i,j+1,k))/5.0
     end do
  end do
  !$OMP END DO
  !$OMP END PARALLEL

in main program:

  call omp_set_nested(.true.)

  !$OMP PARALLEL SECTIONS
  !$OMP SECTION
  print *, 'Zahl der Threads in parallel sections: ', 
          omp_get_num_threads()
  call smooth(a, 1, work)
  !$OMP SECTION
  call smooth(a, 2, work)
  !$OMP SECTION
  call smooth(a, 3, work)
  !$OMP END PARALLEL SECTIONS

poisson1.f90

in sweep:

  do i = 2, n-1
     do j = 2, n-1
        resid = a(i-1,j) + a(i+1,j) + a(i,j+1) + a(i,j-1) + &
               (-4.0)*a(i,j) - f(i,j)
        sweep = sweep + abs(resid)
        b(i,j) = a(i,j) + 0.25*resid
     end do
  end do

in main program:

  do it = 1, maxits
     error = sweep(u1, q, u2)
     error = sweep(u2, q, u1)
     if (error/(n*n) < eps) exit
  end do

poisson2.f90

in sweep:

  !$OMP DO
  do i = 2, n-1
     do j = 2, n-1
        resid = a(i-1,j) + a(i+1,j) + a(i,j+1) + a(i,j-1) + &
               (-4.0)*a(i,j) - f(i,j)
        sweep = sweep + abs(resid)
        b(i,j) = a(i,j) + 0.25*resid
     end do
  end do
  !$OMP END DO

in main program:

  !$OMP PARALLEL PRIVATE(error)
  do it = 1, maxits
     error = sweep(u1, q, u2)
     error = sweep(u2, q, u1)
     if (error/(n*n) < eps) exit
  end do

  !$OMP SINGLE
  print *, 'Fehler nach ', it, ' Iterationen: ', error/(n*n)
  !$OMP END SINGLE
  !$OMP END PARALLEL

poisson3.f90

in main program:

  !$OMP PARALLEL PRIVATE(error)
  do it = 1, maxits
     error = sweep(u1, q, u2)
     error = sweep(u2, q, u1)

     ! sum local errors
     !$OMP SINGLE
     total_error = 0.0
     !$OMP END SINGLE

     !$OMP CRITICAL
     total_error = total_error + error
     !$OMP END CRITICAL
     !$OMP BARRIER

     if (total_error/(n*n) < eps) exit
  end do

  !$OMP SINGLE
  print *, 'Fehler nach ', it, ' Iterationen: ', total_error/(n*n)
  !$OMP END SINGLE

  !$OMP END PARALLEL

poisson4.f90

module myshared:

  module myshared
    use kinds
    implicit none

    real(kind=REAL8) :: total_error
  end module myshared

in sweep:

  use myshared
    ..
  !$OMP DO
  do i = 2, n-1
     do j = 2, n-1
        resid = a(i-1,j) + a(i+1,j) + a(i,j+1) + a(i,j-1) + &
               (-4.0)*a(i,j) - f(i,j)
        error = error + abs(resid)
        b(i,j) = a(i,j) + 0.25*resid
     end do
  end do
  !$OMP END DO

  ! sum local errors
  !$OMP SINGLE
  total_error = 0.0
  !$OMP END SINGLE
    
  !$OMP CRITICAL
  total_error = total_error + error
  !$OMP END CRITICAL
  !$OMP BARRIER

  sweep = total_error

in main program:

  !$OMP PARALLEL PRIVATE(error)
  do it = 1, maxits
     error = sweep(u1, q, u2)
     error = sweep(u2, q, u1)
     if (error/(n*n) < eps) exit
  end do

Peter Junglas 18.5.1999