libgomp/testsuite/libgomp.oacc-fortran/gemm-2.f90

   1 ! Exercise three levels of parallelism using SGEMM from BLAS.
   2
   3 ! { dg-do run }
   4 ! { dg-additional-options "-fopenacc-dim=::128" }
   5
   6 ! { dg-additional-options -Wuninitialized }
   7
   8 ! Implicitly set vector_length to 128 using -fopenacc-dim.
   9 subroutine openacc_sgemm (m, n, k, alpha, a, b, beta, c)
  10   integer :: m, n, k
  11   real :: alpha, beta
  12   real :: a(k,*), b(k,*), c(m,*)
  13
  14   integer :: i, j, l
  15   real :: temp
  16   ! { dg-note {'temp' was declared here} {} { target *-*-* } .-1 }
  17
  18   !$acc parallel loop copy(c(1:m,1:n)) copyin(a(1:k,1:m),b(1:k,1:n)) firstprivate (temp)
  19   ! { dg-warning {'temp' is used uninitialized} {} { target *-*-* } .-1 }
  20   do j = 1, n
  21      !$acc loop
  22      do i = 1, m
  23         temp = 0.0
  24         !$acc loop reduction(+:temp)
  25         do l = 1, k
  26            temp = temp + a(l,i)*b(l,j)
  27         end do
  28         if(beta == 0.0) then
  29            c(i,j) = alpha*temp
  30         else
  31            c(i,j) = alpha*temp + beta*c(i,j)
  32         end if
  33      end do
  34   end do
  35 end subroutine openacc_sgemm
  36
  37 subroutine host_sgemm (m, n, k, alpha, a, b, beta, c)
  38   integer :: m, n, k
  39   real :: alpha, beta
  40   real :: a(k,*), b(k,*), c(m,*)
  41
  42   integer :: i, j, l
  43   real :: temp
  44
  45   do j = 1, n
  46      do i = 1, m
  47         temp = 0.0
  48         do l = 1, k
  49            temp = temp + a(l,i)*b(l,j)
  50         end do
  51         if(beta == 0.0) then
  52            c(i,j) = alpha*temp
  53         else
  54            c(i,j) = alpha*temp + beta*c(i,j)
  55         end if
  56      end do
  57   end do
  58 end subroutine host_sgemm
  59
  60 program main
  61   integer, parameter :: M = 100, N = 50, K = 2000
  62   real :: a(K, M), b(K, N), c(M, N), d (M, N), e (M, N)
  63   real alpha, beta
  64   integer i, j
  65
  66   a(:,:) = 1.0
  67   b(:,:) = 0.25
  68
  69   c(:,:) = 0.0
  70   d(:,:) = 0.0
  71   e(:,:) = 0.0
  72
  73   alpha = 1.05
  74   beta = 1.25
  75
  76   call openacc_sgemm (M, N, K, alpha, a, b, beta, c)
  77   call host_sgemm (M, N, K, alpha, a, b, beta, e)
  78
  79   do i = 1, m
  80      do j = 1, n
  81         if (c(i,j) /= e(i,j)) stop 1
  82      end do
  83   end do
  84 end program main