Программы на Фортране с использованием технологии OpenMP
Умножение матрицНиже приведена тестовая программа умножения матриц. В этой программе есть блок обычного умножения и параллельного умножения с использованием технологии OpenMP.
program my_transpose
include "omp_lib.h"
double precision start_time, end_time, tick
real(8), allocatable, target :: A(:,:)
real(8), allocatable, target :: C(:,:)
integer N,i,j,k
write(*,*) "N="
read(*,*) N
allocate(A(N,N))
write(*,*) "Создание матрицы"
start_time = omp_get_wtime()
do i=1,N
do j=1,N
A(i,j)=sin(i*1.0)*cos(j*1.0)
end do
end do
end_time = omp_get_wtime()
tick = omp_get_wtick()
print *, "Время генерации матрицы", end_time-start_time
print *, "Точность таймера ", tick
write(*,*)
allocate(C(N,N))
write(*,*) "Последовательное умножение"
write(*,*)
start_time = omp_get_wtime()
do i=1,n
do j=1,n
c(i,j)=0
do k=1,n
c(i,j)=c(i,j)+a(k,i)*a(k,j)
end do
end do
end do
end_time = omp_get_wtime()
tick = omp_get_wtick()
print *, "Время на последовательного умножения ", end_time-start_time
print *, "Точность таймера ", tick
write(*,*)
write(*,*) "Параллельное умножение"
write(*,*)
start_time = omp_get_wtime()
!$omp parallel do shared(a, c) private(i, j, k)
do i=1,n
do j=1,n
c(i,j)=0
do k=1,n
c(i,j)=c(i,j)+a(k,i)*a(k,j)
end do
end do
end do
write(*,*)
end_time = omp_get_wtime()
tick = omp_get_wtick()
print *, "Время параллельного умножения", end_time-start_time
print *, "Точность таймера ", tick
deallocate(A)
deallocate(C)
end
Тестирование программы проходило на ПК с материнской платой MSI H67MA-E45, процессор Intel Core I5 (3.3 Ггц), ОЗУ 4 Гб, ОС Xubuntu 11.10 c pae ядром, компилятор g++ 4.6.
Результаты тестирования представлены в таблице 1 и на рис. 1.
Таблица 1.
| Время, с | Размерность матрицы | 200 | 500 | 1000 | 1500 | 2000 | 2500 | 3000 | 3500 | 4000 |
| 1 ядро, Fortran | 0.053 | 0.62 | 5.1 | 17.1 | 41.22 | 78.63 | 135.8 | 215.28 | 322.06 | |
| 4 ядра, Fortran | 0.022 | 0.31 | 2.6 | 8.57 | 20.33 | 39.39 | 68.83 | 108.57 | 162.19 |
Рисунок 1
Решение СЛАУ методом простой итерации
Ниже приведена тестовая программа решения СЛАУ, система уравнений формировалась, удовлетворяющая условию сходимости, с диагональным преобладанием. В этой программе есть подпрограммы обычного и параллельного (с использованием технологии OpenMP) решения СЛАУ методом простой итерации.
program my_transpose
include "omp_lib.h"
double precision start_time, end_time, tick
real(8), allocatable, target :: A_(:,:)
real(8), allocatable, target :: X_(:)
real(8), allocatable, target :: B_(:)
integer N_,i,j,k
write(*,*) "N="
read(*,*) N_
allocate(A_(N_,N_))
allocate(B_(N_))
allocate(X_(N_))
print *, "В системе",omp_get_num_procs()," процессоров"
do i=1,N_
do j=1,N_
if (i == j) then
A_(i,j)=1
else
A_(i,j)=0.1/(i+j-2)
end if
end do
end do
do i=1,N_
B_(i)=sin(i*1.0)
end do
write(*,*)
write(*,*) "Последовательное решение СЛАУ методом Якоби"
start_time = omp_get_wtime()
call jacobi_posl(A_,B_, X_, N_, 1e-6,kol)
end_time = omp_get_wtime()
print *, "Время на счёта ", end_time-start_time
print *, "Количество итераций ", kol
write(*,*) "Параллельное решение СЛАУ методом Якоби"
start_time = omp_get_wtime()
call jacobi_pll(A_,B_, X_, N_, 1e-6,kol)
end_time = omp_get_wtime()
print *, "Время на счёта ", end_time-start_time
print *, "Количество итераций ", kol
write(*,*)
deallocate(A_)
deallocate(X_)
deallocate(B_)
contains
subroutine jacobi_posl(a, b, x, N, ep,kvo)
integer, intent (in):: N
real, intent (in):: ep
real(8), intent (in):: a(N,N), b(N)
real(8), intent (inout):: x(N)
integer, intent (inout):: kvo
integer i,j
real(8), allocatable, target :: alf(:,:)
real(8), allocatable, target :: bet(:)
real(8), allocatable, target :: x0(:)
real(8) maxx
allocate(alf(N,N))
allocate(bet(N))
allocate(x0(N))
do i=1,N
bet(i)=b(i)/a(i,i)
do j=1,N
if (i==j) then
alf(i,j)=0
else
alf(i,j)=-a(i,j)/a(i,i)
end if
end do
end do
x=bet
kvo=0
maxx=5*ep;
do while (maxx>=ep)
x0=x
x=MATMUL(alf,x0)+bet
maxx=MAXVAL(abs(x0-x))
kvo=kvo+1
end do
deallocate(alf)
deallocate(bet)
deallocate(x0)
end subroutine jacobi_posl
subroutine jacobi_pll(a, b, x, N, ep,kvo)
integer, intent (in):: N
real, intent (in):: ep
real(8), intent (in):: a(N,N), b(N)
real(8), intent (inout):: x(N)
integer, intent (inout):: kvo
integer i,j
real(8), allocatable, target :: alf(:,:)
real(8), allocatable, target :: bet(:)
real(8), allocatable, target :: x0(:)
real(8) maxx
allocate(alf(N,N))
allocate(bet(N))
allocate(x0(N))
!$omp parallel do shared(a, b)
do i=1,N
bet(i)=b(i)/a(i,i)
do j=1,N
if (i==j) then
alf(i,j)=0
else
alf(i,j)=-a(i,j)/a(i,i)
end if
end do
end do
x=bet
kvo=0
maxx=5*ep;
do while (maxx>=ep)
x0=x
x=MATMUL(alf,x0)
x=x+bet
maxx=MAXVAL(abs(x0-x))
kvo=kvo+1
end do
deallocate(alf)
deallocate(bet)
deallocate(x0)
end subroutine jacobi_pll
end
Тестирование программы проходило на ПК с материнской платой MSI H67MA-E45, процессор Intel Core I5 (3.3 Ггц), ОЗУ 4 Гб, ОС Xubuntu 11.10 c pae ядром, компилятор g++ 4.6.
Результаты тестирования представлены в таблице 2 и на рис. 2.
Таблица 2.
| Время, с | Размерность матрицы | 500 | 1000 | 2000 | 5000 | 7000 | 8000 | 9000 | 10000 | 11000 |
| 1 ядро, Fortran | 0.0049 | 0.022 | 0.103 | 0.76 | 1.5 | 3.29 | 2.7 | 4.01 | 4.7 | |
| 4 ядра, Fortran | 0.0023 | 0.011 | 0.049 | 0.32 | 0.79 | 1.92 | 2.13 | 3.2 | 4.01 |
Рисунок 2