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

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