URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [libgomp/] [testsuite/] [libgomp.fortran/] [strassen.f90] - Blame information for rev 407

Go to most recent revision | Details | Compare with Previous | View Log


! { dg-options "-O2" }
 
program strassen_matmul
  use omp_lib
  integer, parameter :: N = 1024
  double precision, save :: A(N,N), B(N,N), C(N,N), D(N,N)
  double precision :: start, end
 
  call random_seed
  call random_number (A)
  call random_number (B)
  start = omp_get_wtime ()
  C = matmul (A, B)
  end = omp_get_wtime ()
  write(*,'(a, f10.6)') ' Time for matmul      = ', end - start
  D = 0
  start = omp_get_wtime ()
  call strassen (A, B, D, N)
  end = omp_get_wtime ()
  write(*,'(a, f10.6)') ' Time for Strassen    = ', end - start
  if (sqrt (sum ((C - D) ** 2)) / N .gt. 0.1) call abort
  D = 0
  start = omp_get_wtime ()
!$omp parallel
!$omp single
  call strassen (A, B, D, N)
!$omp end single nowait
!$omp end parallel
  end = omp_get_wtime ()
  write(*,'(a, f10.6)') ' Time for Strassen MP = ', end - start
  if (sqrt (sum ((C - D) ** 2)) / N .gt. 0.1) call abort
 
contains
 
  recursive subroutine strassen (A, B, C, N)
    integer, intent(in) :: N
    double precision, intent(in) :: A(N,N), B(N,N)
    double precision, intent(out) :: C(N,N)
    double precision :: T(N/2,N/2,7)
    integer :: K, L
 
    if (iand (N,1) .ne. 0 .or. N < 64) then
      C = matmul (A, B)
      return
    end if
    K = N / 2
    L = N / 2 + 1
!$omp task shared (A, B, T)
    call strassen (A(:K,:K) + A(L:,L:), B(:K,:K) + B(L:,L:), T(:,:,1), K)
!$omp end task
!$omp task shared (A, B, T)
    call strassen (A(L:,:K) + A(L:,L:), B(:K,:K), T(:,:,2), K)
!$omp end task
!$omp task shared (A, B, T)
    call strassen (A(:K,:K), B(:K,L:) - B(L:,L:), T(:,:,3), K)
!$omp end task
!$omp task shared (A, B, T)
    call strassen (A(L:,L:), B(L:,:K) - B(:K,:K), T(:,:,4), K)
!$omp end task
!$omp task shared (A, B, T)
    call strassen (A(:K,:K) + A(:K,L:), B(L:,L:), T(:,:,5), K)
!$omp end task
!$omp task shared (A, B, T)
    call strassen (A(L:,:K) - A(:K,:K), B(:K,:K) + B(:K,L:), T(:,:,6), K)
!$omp end task
!$omp task shared (A, B, T)
    call strassen (A(:K,L:) - A(L:,L:), B(L:,:K) + B(L:,L:), T(:,:,7), K)
!$omp end task
!$omp taskwait
    C(:K,:K) = T(:,:,1) + T(:,:,4) - T(:,:,5) + T(:,:,7)
    C(L:,:K) = T(:,:,2) + T(:,:,4)
    C(:K,L:) = T(:,:,3) + T(:,:,5)
    C(L:,L:) = T(:,:,1) - T(:,:,2) + T(:,:,3) + T(:,:,6)
  end subroutine strassen
end

Line No.	Rev	Author	Line
1	273	jeremybenn	`! { dg-options "-O2" }`
2
3			`program strassen_matmul`
4			`use omp_lib`
5			`integer, parameter :: N = 1024`
6			`double precision, save :: A(N,N), B(N,N), C(N,N), D(N,N)`
7			`double precision :: start, end`
8
9			`call random_seed`
10			`call random_number (A)`
11			`call random_number (B)`
12			`start = omp_get_wtime ()`
13			`C = matmul (A, B)`
14			`end = omp_get_wtime ()`
15			`write(*,'(a, f10.6)') ' Time for matmul = ', end - start`
16			`D = 0`
17			`start = omp_get_wtime ()`
18			`call strassen (A, B, D, N)`
19			`end = omp_get_wtime ()`
20			`write(*,'(a, f10.6)') ' Time for Strassen = ', end - start`
21			`if (sqrt (sum ((C - D) ** 2)) / N .gt. 0.1) call abort`
22			`D = 0`
23			`start = omp_get_wtime ()`
24			`!$omp parallel`
25			`!$omp single`
26			`call strassen (A, B, D, N)`
27			`!$omp end single nowait`
28			`!$omp end parallel`
29			`end = omp_get_wtime ()`
30			`write(*,'(a, f10.6)') ' Time for Strassen MP = ', end - start`
31			`if (sqrt (sum ((C - D) ** 2)) / N .gt. 0.1) call abort`
32
33			`contains`
34
35			`recursive subroutine strassen (A, B, C, N)`
36			`integer, intent(in) :: N`
37			`double precision, intent(in) :: A(N,N), B(N,N)`
38			`double precision, intent(out) :: C(N,N)`
39			`double precision :: T(N/2,N/2,7)`
40			`integer :: K, L`
41
42			`if (iand (N,1) .ne. 0 .or. N < 64) then`
43			`C = matmul (A, B)`
44			`return`
45			`end if`
46			`K = N / 2`
47			`L = N / 2 + 1`
48			`!$omp task shared (A, B, T)`
49			`call strassen (A(:K,:K) + A(L:,L:), B(:K,:K) + B(L:,L:), T(:,:,1), K)`
50			`!$omp end task`
51			`!$omp task shared (A, B, T)`
52			`call strassen (A(L:,:K) + A(L:,L:), B(:K,:K), T(:,:,2), K)`
53			`!$omp end task`
54			`!$omp task shared (A, B, T)`
55			`call strassen (A(:K,:K), B(:K,L:) - B(L:,L:), T(:,:,3), K)`
56			`!$omp end task`
57			`!$omp task shared (A, B, T)`
58			`call strassen (A(L:,L:), B(L:,:K) - B(:K,:K), T(:,:,4), K)`
59			`!$omp end task`
60			`!$omp task shared (A, B, T)`
61			`call strassen (A(:K,:K) + A(:K,L:), B(L:,L:), T(:,:,5), K)`
62			`!$omp end task`
63			`!$omp task shared (A, B, T)`
64			`call strassen (A(L:,:K) - A(:K,:K), B(:K,:K) + B(:K,L:), T(:,:,6), K)`
65			`!$omp end task`
66			`!$omp task shared (A, B, T)`
67			`call strassen (A(:K,L:) - A(L:,L:), B(L:,:K) + B(L:,L:), T(:,:,7), K)`
68			`!$omp end task`
69			`!$omp taskwait`
70			`C(:K,:K) = T(:,:,1) + T(:,:,4) - T(:,:,5) + T(:,:,7)`
71			`C(L:,:K) = T(:,:,2) + T(:,:,4)`
72			`C(:K,L:) = T(:,:,3) + T(:,:,5)`
73			`C(L:,L:) = T(:,:,1) - T(:,:,2) + T(:,:,3) + T(:,:,6)`
74			`end subroutine strassen`
75			`end`

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [libgomp/] [testsuite/] [libgomp.fortran/] [strassen.f90] - Blame information for rev 407