rocBLAS examples#
rocBLAS is the AMD
implementation of the Basic Linear Algebra Subprograms (BLAS) for AMD GPUs.
hipFORT exposes it through the hipfort_rocblas module, which mirrors the
rocBLAS C API one to one, together with hipfort_rocblas_enums for the
enumerations (rocblas_operation_none, rocblas_fill_lower and so on).
rocSOLVER and rocSPARSE reuse the rocBLAS handle type, so the patterns on this
page carry over to those libraries as well.
Every program on this page is a complete, self-contained example that is built
and run as part of the hipFORT test suite. The Fortran 2008 sources live in
test/f2008/rocblas. Most of them have an equivalent Fortran 2003 source in
test/f2003/rocblas, which uses type(c_ptr) device pointers and explicit
byte counts instead of Fortran array pointers. The two batched-pointer and
packed-storage examples, dgemv_batched and stpsv, are Fortran 2008
only. One further program, test/f2018/rocblas/saxpy.f90, exercises the
Fortran 2018 assumed-rank interfaces and is described below.
hipBLAS offers the same functionality through an API that follows cuBLAS; see the hipBLAS examples.
The examples are grouped the way the BLAS routines themselves are: Level 1
operates on vectors, Level 2 on a matrix and a vector, and Level 3 on two
matrices. Most routines are provided in four precisions, identified by the
usual BLAS prefix: s (single-precision real), d (double-precision
real), c (single-precision complex) and z (double-precision complex).
Each section below shows one precision and names the sibling test files that
cover the others.
rocBLAS call pattern#
A rocBLAS program always follows the same sequence:
Create a handle with
rocblas_create_handle.Optionally choose how scalar arguments and results are passed with
rocblas_set_pointer_mode: host pointer mode (0) readsalpha,betaand scalar results such as a dot product from host memory, while device pointer mode expects them on the device.Allocate device memory and copy the input data over, either with
hipMalloc/hipMemcpyor, in the Fortran 2008 interfaces, with thehipMalloc(source=...)shortcut that allocates and copies in one call.Call the rocBLAS routine.
Call
hipDeviceSynchronizebefore reading a result, whether it was written to a host scalar or to device memory.Copy device results back to the host.
Free the device memory and release the handle with
rocblas_destroy_handle.
Keep the following conventions in mind:
rocBLAS matrices are stored column-major, which matches Fortran’s native array layout directly, so no transpose trick is needed to call rocBLAS from Fortran.
The leading dimension of a device matrix is usually just its first dimension,
size(dA,1).Enumerations such as
rocblas_operation_none,rocblas_fill_lower,rocblas_diagonal_non_unitandrocblas_side_leftcome from thehipfort_rocblas_enumsmodule (re-exported byhipfort_rocblas).Every rocBLAS call returns a status code. The examples wrap them in
rocblasCheckfrom thehipfort_checkmodule, which aborts on failure. (dgemv_batched.f08useshipCheckfor its rocBLAS calls instead; both abort on a non-zero status.)
Building an example#
The examples only need the rocblas and hip hipFORT components:
find_package(hipfort REQUIRED COMPONENTS hip rocblas)
add_executable(my_blas saxpy.f08)
target_link_libraries(my_blas PRIVATE hipfort::rocblas hipfort::hip)
See Using hipFORT in your application for the full set of build options.
Level 1: vector operations#
Scaled vector update (axpy)#
rocblas_?axpy computes y := alpha * x + y. This example runs it in
single precision and checks the result against the expected value.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2022 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_saxpy_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer, parameter :: N = 12000
real(c_float), target :: alpha = 12.5
real,allocatable,target,dimension(:) :: hx
real,allocatable,target,dimension(:) :: hy
real,allocatable,target,dimension(:) :: hz
real,pointer,dimension(:) :: dx
real,pointer,dimension(:) :: dy
real :: error
real :: result
real, parameter :: error_max = 10 * epsilon(error_max)
type(c_ptr) :: rocblas_handle
integer :: i
write(*,"(a)",advance="no") "-- Running test 'saxpy' (Fortran 2008 interfaces) - "
! Create rocblas handle
call rocblasCheck(rocblas_create_handle(rocblas_handle))
! Allocate host-side memory
allocate(hx(N))
allocate(hy(N))
allocate(hz(N))
! Initialize host memory
do i = 1, N
hx(i) = i
hy(i) = N - i
hz(i) = N - i
eNd do
! Allocate device-side memory
! Transfer data from host to device memory
call hipCheck(hipMalloc(dx, source=hx))
call hipCheck(hipMalloc(dy, source=hy))
! Call rocblas function
call rocblasCheck(rocblas_set_pointer_mode(rocblas_handle, 0))
call rocblasCheck(rocblas_saxpy(rocblas_handle, N, alpha, dx, 1, dy, 1))
call hipCheck(hipDeviceSynchronize())
! Transfer data back to host memory
call hipcheck(hipMemcpy(hy, dy, hipMemcpyDeviceToHost))
! Verification
do i = 1, N
result = alpha * hx(i) + hz(i)
error = abs(hy(i) - result)
if(error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " hy(", i, ") = ", hy(i)
call exit
end if
end do
! Cleanup
call hipCheck(hipFree(dx))
call hipCheck(hipFree(dy))
deallocate(hx, hy, hz)
call rocblasCheck(rocblas_destroy_handle(rocblas_handle))
write(*,*) "PASSED!"
end program rocblas_saxpy_test
test/f2008/rocblas/daxpy.f08, caxpy.f08 and zaxpy.f08 run the same
computation in double-precision real, single-precision complex and
double-precision complex, respectively.
Arrays of rank greater than one#
The Fortran 2008 array interfaces shown above are generated per rank and stop
at rank 1 for vector arguments, so a rank-3 array cannot be handed to
rocblas_saxpy directly. Building hipFORT with the HIPFORT_ASSUMED_RANK
option replaces those rank-specific overloads with a single Fortran 2018
dimension(..) wrapper that accepts an array of any rank. The following
program passes rank-3 dx and dy to the same generic, with n
counting all of the elements:
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Exercises the experimental F2018 assumed-rank interfaces: a rank-3 array is
! passed to the rocblas_saxpy generic. The classic rank-specific overloads only
! cover up to rank 1, so this compiles/resolves ONLY with HIPFORT_ASSUMED_RANK
! (a single dimension(..) wrapper accepts any rank). Demonstrates the rank > 2
! support requested in https://github.com/ROCm/hipfort/issues/175.
program rocblas_saxpy_rank3_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer, parameter :: nx = 2, ny = 3, nz = 4, n = nx*ny*nz
real(c_float), allocatable, dimension(:,:,:) :: hx, hy
real(c_float), pointer, dimension(:,:,:) :: dx => null(), dy => null()
real(c_float) :: alpha = 2.0
real(c_float), parameter :: y_exact = 5.0 ! alpha*1 + 3 = 5
type(c_ptr) :: handle = c_null_ptr
integer :: i, j, k
real(c_float) :: error
real(c_float), parameter :: error_max = 10*epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'SAXPY rank-3' (Fortran 2018 assumed-rank interfaces) - "
call rocblasCheck(rocblas_create_handle(handle))
allocate(hx(nx,ny,nz), hy(nx,ny,nz))
hx = 1.0
hy = 3.0
call hipCheck(hipMalloc(dx, source=hx))
call hipCheck(hipMalloc(dy, source=hy))
! Rank-3 dx/dy passed directly to the generic; n counts all elements. Resolves
! to the assumed-rank specific (rank > 1 is impossible with the classic form).
call rocblasCheck(rocblas_saxpy(handle, n, alpha, dx, 1, dy, 1))
call hipCheck(hipDeviceSynchronize())
call hipCheck(hipMemcpy(hy, dy, hipMemcpyDeviceToHost))
do k = 1, nz
do j = 1, ny
do i = 1, nx
error = abs((y_exact - hy(i,j,k))/y_exact)
if( error > error_max )then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " hy = ", hy(i,j,k)
call exit(1)
end if
end do
end do
end do
call hipCheck(hipFree(dx))
call hipCheck(hipFree(dy))
call rocblasCheck(rocblas_destroy_handle(handle))
deallocate(hx, hy)
write(*,*) "PASSED!"
end program rocblas_saxpy_rank3_test
This is the only assumed-rank example in the test suite, and it is skipped
unless HIPFORT_ASSUMED_RANK is enabled.
Vector scaling (scal)#
rocblas_?scal computes x := alpha * x. The operation is in place, so
the device vector is both the input and the output; this example copies the
result into a second host array to keep the original input available for
verification.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_sscal_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer, parameter :: N = 12000
real(c_float),target :: alpha = 12.5
real(c_float),allocatable,target,dimension(:) :: hx
real(c_float),allocatable,target,dimension(:) :: hres
real(c_float),pointer,dimension(:) :: dx
real(c_float) :: expected
real(c_float) :: error
real(c_float), parameter :: error_max = 10 * epsilon(error_max)
type(c_ptr) :: rocblas_handle
integer :: i
write(*,"(a)",advance="no") "-- Running test 'sscal' (Fortran 2008 interfaces) - "
! Create rocblas handle
call rocblasCheck(rocblas_create_handle(rocblas_handle))
! Allocate host-side memory
allocate(hx(N))
allocate(hres(N))
! Initialize host memory. alpha*i = 12.5*i is exact in binary floating
! point for i <= N (25*12000 < 2**25), so a correct result has zero error.
do i = 1, N
hx(i) = i
end do
! Allocate device-side memory
! Transfer data from host to device memory
call hipCheck(hipMalloc(dx, source=hx))
! Call rocblas function. scal is in-place: dx is both input and output.
call rocblasCheck(rocblas_set_pointer_mode(rocblas_handle, 0))
call rocblasCheck(rocblas_sscal(rocblas_handle, N, alpha, dx, 1))
call hipCheck(hipDeviceSynchronize())
! Transfer data back into a separate array so hx stays pristine for
! verification; scal overwrote its input device-side.
call hipCheck(hipMemcpy(hres, dx, hipMemcpyDeviceToHost))
! Verification
do i = 1, N
expected = alpha * hx(i)
error = abs((expected - hres(i)) / expected)
if(error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " hres(", i, ") = ", hres(i)
call exit(1)
end if
end do
! Cleanup
call hipCheck(hipFree(dx))
deallocate(hx, hres)
call rocblasCheck(rocblas_destroy_handle(rocblas_handle))
write(*,*) "PASSED!"
end program rocblas_sscal_test
test/f2008/rocblas/dscal.f08, cscal.f08 and zscal.f08 cover the
remaining precisions.
Complex vectors additionally have a mixed-precision form in which alpha is
real rather than complex: rocblas_csscal scales a single-precision complex
vector by a single-precision real scalar, and rocblas_zdscal does the same
in double precision. See test/f2008/rocblas/csscal.f08 and zdscal.f08.
Dot products#
rocblas_?dot computes the dot product of two real vectors and returns the
scalar result through a pointer whose location (host or device) is set by
rocblas_set_pointer_mode.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_sdot_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer, parameter :: N = 10240
real(c_float),allocatable,target,dimension(:) :: hx
real(c_float),allocatable,target,dimension(:) :: hy
real(c_float),target :: res
real(c_float),pointer,dimension(:) :: dx
real(c_float),pointer,dimension(:) :: dy
real(c_float) :: res_exact
real(c_float) :: error
real(c_float), parameter :: error_max = 10 * epsilon(error_max)
type(c_ptr) :: rocblas_handle
write(*,"(a)",advance="no") "-- Running test 'sdot' (Fortran 2008 interfaces) - "
! Create rocblas handle
call rocblasCheck(rocblas_create_handle(rocblas_handle))
call rocblasCheck(rocblas_set_pointer_mode(rocblas_handle, 0)) ! host pointer mode
! Allocate host-side memory
allocate(hx(N))
allocate(hy(N))
! Initialize host memory
hx = 1.0 ! x = 1
hy = 2.0 ! y = 2
res_exact = 2.0 * N ! sum(x*y) = 2n
! Allocate device-side memory
! Transfer data from host to device memory
call hipCheck(hipMalloc(dx, source=hx))
call hipCheck(hipMalloc(dy, source=hy))
! Call rocblas function
res = 0.0
call rocblasCheck(rocblas_sdot(rocblas_handle, N, dx, 1, dy, 1, c_loc(res)))
call hipCheck(hipDeviceSynchronize()) ! res now valid host-side
! Verification
error = abs((res_exact - res) / res_exact)
if(error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " result = ", res
call exit(1)
end if
! Cleanup
call hipCheck(hipFree(dx))
call hipCheck(hipFree(dy))
deallocate(hx, hy)
call rocblasCheck(rocblas_destroy_handle(rocblas_handle))
write(*,*) "PASSED!"
end program rocblas_sdot_test
test/f2008/rocblas/ddot.f08 is the double-precision equivalent.
Complex vectors have two dot product variants: rocblas_?dotc conjugates
the first vector before multiplying, and rocblas_?dotu does not. Compare
test/f2008/rocblas/cdotc.f08 and cdotu.f08 (also available in double
precision as zdotc.f08 and zdotu.f08) to see the different expected
results for the same input data.
Euclidean norm (nrm2)#
rocblas_?nrm2 computes the Euclidean norm of a vector and returns it
through a pointer whose location follows the pointer mode.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_snrm2_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer, parameter :: N = 1024
real(c_float),allocatable,target,dimension(:) :: hx
real(c_float),target :: res
real(c_float),pointer,dimension(:) :: dx
real(c_float) :: res_exact
real(c_float) :: error
real(c_float), parameter :: error_max = 10 * epsilon(error_max)
type(c_ptr) :: rocblas_handle
write(*,"(a)",advance="no") "-- Running test 'snrm2' (Fortran 2008 interfaces) - "
! Create rocblas handle
call rocblasCheck(rocblas_create_handle(rocblas_handle))
call rocblasCheck(rocblas_set_pointer_mode(rocblas_handle, 0)) ! host pointer mode
! Allocate and initialize host memory: x = 1, so nrm2 = sqrt(n)
allocate(hx(N))
hx = 1.0
res_exact = sqrt(real(N, kind=kind(res_exact)))
! Allocate device-side memory and transfer the input
call hipCheck(hipMalloc(dx, source=hx))
! Call rocblas function
res = 0.0
call rocblasCheck(rocblas_snrm2(rocblas_handle, N, c_loc(dx(1)), 1, c_loc(res)))
call hipCheck(hipDeviceSynchronize()) ! res now valid host-side
! Verification
error = abs((res_exact - res) / res_exact)
if(error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " result = ", res
call exit(1)
end if
! Cleanup
call hipCheck(hipFree(dx))
deallocate(hx)
call rocblasCheck(rocblas_destroy_handle(rocblas_handle))
write(*,*) "PASSED!"
end program rocblas_snrm2_test
test/f2008/rocblas/dnrm2.f08 is the double-precision equivalent. The
complex forms are named for both types involved, because the norm of a complex
vector is real: rocblas_scnrm2 takes a single-precision complex vector and
returns a single-precision real result, and rocblas_dznrm2 is its
double-precision counterpart. See scnrm2.f08 and dznrm2.f08.
Sum of absolute values (asum)#
rocblas_?asum sums the absolute values of a vector’s elements. For complex
vectors it sums abs(real(x)) + abs(aimag(x)) per element rather than the
complex modulus.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_sasum_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer, parameter :: N = 1024
real(c_float),allocatable,target,dimension(:) :: hx
real(c_float),target :: res
real(c_float),pointer,dimension(:) :: dx
real(c_float) :: res_exact
real(c_float) :: error
real(c_float), parameter :: error_max = 10 * epsilon(error_max)
type(c_ptr) :: rocblas_handle
write(*,"(a)",advance="no") "-- Running test 'sasum' (Fortran 2008 interfaces) - "
! Create rocblas handle
call rocblasCheck(rocblas_create_handle(rocblas_handle))
call rocblasCheck(rocblas_set_pointer_mode(rocblas_handle, 0)) ! host pointer mode
! Allocate and initialize host memory: x = 1, so asum = n
allocate(hx(N))
hx = 1.0
res_exact = real(N, kind=kind(res_exact))
! Allocate device-side memory and transfer the input
call hipCheck(hipMalloc(dx, source=hx))
! Call rocblas function
res = 0.0
call rocblasCheck(rocblas_sasum(rocblas_handle, N, c_loc(dx(1)), 1, c_loc(res)))
call hipCheck(hipDeviceSynchronize()) ! res now valid host-side
! Verification
error = abs((res_exact - res) / res_exact)
if(error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " result = ", res
call exit(1)
end if
! Cleanup
call hipCheck(hipFree(dx))
deallocate(hx)
call rocblasCheck(rocblas_destroy_handle(rocblas_handle))
write(*,*) "PASSED!"
end program rocblas_sasum_test
test/f2008/rocblas/dasum.f08 is the double-precision equivalent, and
scasum.f08 and dzasum.f08 are the mixed real/complex forms named on the
same convention as scnrm2.
Index of the largest or smallest element (iamax and iamin)#
rocblas_i?amax returns the index of the element with the largest absolute
value, and rocblas_i?amin the smallest. The returned index is 1-based,
so it can be used to subscript a Fortran array directly.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_isamax_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer, parameter :: N = 8
real(c_float),allocatable,target,dimension(:) :: hx
integer(c_int),target :: res
real(c_float),pointer,dimension(:) :: dx
integer(c_int), parameter :: res_exact = 5 ! rocBLAS returns a 1-based index
type(c_ptr) :: rocblas_handle
write(*,"(a)",advance="no") "-- Running test 'isamax' (Fortran 2008 interfaces) - "
! Create rocblas handle
call rocblasCheck(rocblas_create_handle(rocblas_handle))
call rocblasCheck(rocblas_set_pointer_mode(rocblas_handle, 0)) ! host pointer mode
! Allocate and initialize host memory so that the largest |x| is at index 5
allocate(hx(N))
hx = 1.0
hx(5) = 10.0
! Allocate device-side memory and transfer the input
call hipCheck(hipMalloc(dx, source=hx))
! Call rocblas function
res = 0
call rocblasCheck(rocblas_isamax(rocblas_handle, N, c_loc(dx(1)), 1, c_loc(res)))
call hipCheck(hipDeviceSynchronize()) ! res now valid host-side
! Verification
if(res .ne. res_exact) then
write(*,*) "FAILED! Wrong index! result = ", res, " expected ", res_exact
call exit(1)
end if
! Cleanup
call hipCheck(hipFree(dx))
deallocate(hx)
call rocblasCheck(rocblas_destroy_handle(rocblas_handle))
write(*,*) "PASSED!"
end program rocblas_isamax_test
Both routines exist in all four precisions: isamax.f08, idamax.f08,
icamax.f08 and izamax.f08 for the maximum, and isamin.f08,
idamin.f08, icamin.f08 and izamin.f08 for the minimum.
Level 2: matrix-vector operations#
Matrix-vector multiplication#
rocblas_?gemv computes y := alpha * op(A) * x + beta * y. This example
uses constant matrix and vector entries so the expected result is a constant
vector and easy to check.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_sgemv_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer(kind(rocblas_operation_none)), parameter :: trans = rocblas_operation_none
real(c_float), parameter :: alpha = 1.1, beta = 0.9
integer, parameter :: m = 1024, n = 1024
real(c_float), allocatable, dimension(:,:) :: hA
real(c_float), allocatable, dimension(:) :: hx, hy
real(c_float) :: y_exact
real(c_float), pointer, dimension(:,:) :: dA
real(c_float), pointer, dimension(:) :: dx, dy
type(c_ptr) :: handle = c_null_ptr
integer :: i
real(c_float) :: error
real(c_float), parameter :: error_max = 10*epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'SGEMV' (Fortran 2008 interfaces) - "
! Create rocblas handle and set host pointer mode for host alpha/beta
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0))
allocate(hA(m,n))
allocate(hx(n))
allocate(hy(m))
! Use these constant matrix/vectors so the exact answer is also a
! constant vector and therefore easy to check
hA(:,:) = 1.
hx(:) = 1.
hy(:) = 1.
y_exact = alpha * n + beta ! = 1.1*1024 + 0.9 = 1127.3
! Allocate device memory
call hipCheck(hipMalloc(dA,source=hA)) ! implies (blocking) memcpy
call hipCheck(hipMalloc(dx,source=hx))
call hipCheck(hipMalloc(dy,source=hy))
call rocblasCheck(rocblas_sgemv(handle, trans, m, n, alpha, dA, size(dA,1), dx, 1, beta, dy, 1))
call hipCheck(hipDeviceSynchronize())
! Transfer data back to host memory
call hipCheck(hipMemcpy(hy, dy, hipMemcpyDeviceToHost))
do i = 1,m
error = abs((y_exact - hy(i))/y_exact)
if( error > error_max )then
write(*,*) "FAILED! Error bigger than max! Error = ", error
call exit(1)
end if
end do
call hipCheck(hipFree(dA))
call hipCheck(hipFree(dx))
call hipCheck(hipFree(dy))
call rocblasCheck(rocblas_destroy_handle(handle))
deallocate(hA, hx, hy)
write(*,*) "PASSED!"
end program rocblas_sgemv_test
test/f2008/rocblas/dgemv.f08, cgemv.f08 and zgemv.f08 cover the
remaining precisions.
Batched matrix-vector multiplication#
rocblas_?gemv_batched runs several independent gemv calls in one
launch. A, x and y are each passed as a device array of device
pointers, one per batch, rather than as a single Fortran array, so this
example builds and uploads those pointer arrays explicitly.
!!!!!!!!!!!!!!
! dgemv_batched example (batched matrix-vector, array-of-pointers form)
! see: https:!rocm.docs.amd.com/projects/rocBLAS/en/latest/
!
! Exercises the "array of device pointers" argument class for rocBLAS: A, x and
! y are each a device array of pointers, one per batch. Computes y = A*x for two
! batches (alpha=1, beta=0) and checks the result.
!!!!!!!!!!!!!!
!
program dgemv_batched
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
use hipfort_rocblas_enums
implicit none
integer :: b, i
integer(c_int), parameter :: M = 2, N = 2, lda = 2, incx = 1, incy = 1, batch = 2
real(c_double) :: alpha = 1.0d0, beta = 0.0d0
! A = [[2,0],[0,3]] (column-major), x = [1,1] -> y = [2,3]
real(c_double), target :: hA(2,2) = reshape((/2.0d0, 0.0d0, 0.0d0, 3.0d0/), (/2,2/))
real(c_double), target :: hx(2) = (/1.0d0, 1.0d0/)
real(c_double), target :: hy(2)
real(c_double) :: hy_ref(2) = (/2.0d0, 3.0d0/)
type(c_ptr) :: dA1=c_null_ptr, dA2=c_null_ptr, dx1=c_null_ptr, dx2=c_null_ptr, dy1=c_null_ptr, dy2=c_null_ptr
type(c_ptr), target :: hAp(batch), hxp(batch), hyp(batch)
type(c_ptr) :: dAp=c_null_ptr, dxp=c_null_ptr, dyp=c_null_ptr, handle=c_null_ptr
integer(c_size_t) :: mbytes, vbytes, psize
real(c_double) :: error
real(c_double), parameter :: error_max = 10 * epsilon(error_max)
write(*,"(a)",advance="no") "-- Running test 'rocblas_dgemv_batched' (Fortran 2008 interfaces) - "
mbytes = int(M,c_size_t) * int(N,c_size_t) * 8
vbytes = int(M,c_size_t) * 8
psize = c_sizeof(dA1)
call hipCheck(hipMalloc(dA1, mbytes)); call hipCheck(hipMalloc(dA2, mbytes))
call hipCheck(hipMalloc(dx1, vbytes)); call hipCheck(hipMalloc(dx2, vbytes))
call hipCheck(hipMalloc(dy1, vbytes)); call hipCheck(hipMalloc(dy2, vbytes))
call hipCheck(hipMemcpy(dA1, c_loc(hA(1,1)), mbytes, hipMemcpyHostToDevice))
call hipCheck(hipMemcpy(dA2, c_loc(hA(1,1)), mbytes, hipMemcpyHostToDevice))
call hipCheck(hipMemcpy(dx1, c_loc(hx(1)), vbytes, hipMemcpyHostToDevice))
call hipCheck(hipMemcpy(dx2, c_loc(hx(1)), vbytes, hipMemcpyHostToDevice))
hAp(1) = dA1; hAp(2) = dA2
hxp(1) = dx1; hxp(2) = dx2
hyp(1) = dy1; hyp(2) = dy2
call hipCheck(hipMalloc(dAp, int(batch,c_size_t)*psize))
call hipCheck(hipMemcpy(dAp, c_loc(hAp(1)), int(batch,c_size_t)*psize, hipMemcpyHostToDevice))
call hipCheck(hipMalloc(dxp, int(batch,c_size_t)*psize))
call hipCheck(hipMemcpy(dxp, c_loc(hxp(1)), int(batch,c_size_t)*psize, hipMemcpyHostToDevice))
call hipCheck(hipMalloc(dyp, int(batch,c_size_t)*psize))
call hipCheck(hipMemcpy(dyp, c_loc(hyp(1)), int(batch,c_size_t)*psize, hipMemcpyHostToDevice))
call hipCheck(rocblas_create_handle(handle))
call hipCheck(rocblas_dgemv_batched(handle, rocblas_operation_none, M, N, alpha, dAp, lda, &
dxp, incx, beta, dyp, incy, batch))
call hipCheck(hipDeviceSynchronize())
do b = 1, batch
hy = 0.0d0
if (b == 1) then
call hipCheck(hipMemcpy(c_loc(hy(1)), dy1, vbytes, hipMemcpyDeviceToHost))
else
call hipCheck(hipMemcpy(c_loc(hy(1)), dy2, vbytes, hipMemcpyDeviceToHost))
end if
do i = 1, M
error = abs(hy(i) - hy_ref(i)) / max(abs(hy_ref(i)), 1.0d0)
if (error > error_max) then
write(*,*) "FAILED! batch ", b, " y(", i, ") = ", hy(i), " expected ", hy_ref(i)
call exit(1)
end if
end do
end do
call hipCheck(hipFree(dA1)); call hipCheck(hipFree(dA2))
call hipCheck(hipFree(dx1)); call hipCheck(hipFree(dx2))
call hipCheck(hipFree(dy1)); call hipCheck(hipFree(dy2))
call hipCheck(hipFree(dAp)); call hipCheck(hipFree(dxp)); call hipCheck(hipFree(dyp))
call hipCheck(rocblas_destroy_handle(handle)); call hipCheck(hipDeviceReset())
write(*,*) "PASSED!"
end program dgemv_batched
This is the only batched gemv example; there is no single-precision or
complex counterpart in the test suite.
Rank-1 update (ger)#
rocblas_?ger computes A := alpha * x * y**T + A, adding the outer
product of two vectors to a matrix in place.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_sger_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
! A := alpha*x*y**T + A (rank-1 update). With A = 0 and alpha = 1 the result
! is simply A(i,j) = x(i)*y(j); the data is real-valued so the 'u' and 'c'
! (conjugated) forms agree.
integer, parameter :: m = 3, n = 2
real(c_float), parameter :: alpha = 1.0
real(c_float) :: hx(m) = [1.0, 2.0, 3.0]
real(c_float) :: hy(n) = [10.0, 20.0]
real(c_float) :: hA(m,n)
real(c_float) :: expected(m,n)
real(c_float), pointer, dimension(:) :: dx, dy
real(c_float), pointer, dimension(:,:) :: dA
type(c_ptr) :: handle = c_null_ptr
integer :: i, j
real(c_float) :: error
real(c_float), parameter :: error_max = 10 * epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'sger' (Fortran 2008 interfaces) - "
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0)) ! host pointer mode
hA = 0.0
do j = 1, n
do i = 1, m
expected(i,j) = hx(i) * hy(j)
end do
end do
call hipCheck(hipMalloc(dx, source=hx))
call hipCheck(hipMalloc(dy, source=hy))
call hipCheck(hipMalloc(dA, source=hA))
call rocblasCheck(rocblas_sger(handle, m, n, alpha, dx, 1, dy, 1, dA, size(dA,1)))
call hipCheck(hipDeviceSynchronize())
call hipCheck(hipMemcpy(hA, dA, hipMemcpyDeviceToHost))
do j = 1, n
do i = 1, m
error = abs(expected(i,j) - hA(i,j))
if (error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " at ", i, j
call exit(1)
end if
end do
end do
call hipCheck(hipFree(dx))
call hipCheck(hipFree(dy))
call hipCheck(hipFree(dA))
call rocblasCheck(rocblas_destroy_handle(handle))
write(*,*) "PASSED!"
end program rocblas_sger_test
test/f2008/rocblas/dger.f08 is the double-precision equivalent. Complex
vectors split the routine in two, on the same conjugated/unconjugated
distinction as dotc and dotu: rocblas_?gerc conjugates y and
forms x * y**H, while rocblas_?geru does not and forms x * y**T.
See cgerc.f08, cgeru.f08, zgerc.f08 and zgeru.f08.
Triangular solve#
rocblas_?trsv solves A * x = b in place for a triangular matrix
A, given the fill mode (rocblas_fill_lower or rocblas_fill_upper),
the transpose operation and whether the diagonal is unit or not. dx holds
b on entry and x on exit.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_strsv_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer(kind(rocblas_fill_lower)), parameter :: uplo = rocblas_fill_lower
integer(kind(rocblas_operation_none)), parameter :: transA = rocblas_operation_none
integer(kind(rocblas_diagonal_non_unit)), parameter :: diag = rocblas_diagonal_non_unit
integer, parameter :: m = 1024
real(c_float), allocatable, dimension(:,:) :: hA
real(c_float), allocatable, dimension(:) :: hx
real(c_float), parameter :: x_exact = 1.0
real(c_float), pointer, dimension(:,:) :: dA
real(c_float), pointer, dimension(:) :: dx
type(c_ptr) :: handle = c_null_ptr
integer :: i, j
real(c_float) :: error
real(c_float), parameter :: error_max = 10*epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'STRSV' (Fortran 2008 interfaces) - "
call rocblasCheck(rocblas_create_handle(handle))
allocate(hA(m,m), hx(m))
! Lower-triangular A with all ones on/below the diagonal; upper part zeroed
hA(:,:) = 0.0
do j = 1, m
do i = j, m
hA(i,j) = 1.0
end do
end do
! Right-hand side b(i) = i -> exact solution x(i) = 1
do i = 1, m
hx(i) = real(i)
end do
! Allocate device memory
call hipCheck(hipMalloc(dA, source=hA)) ! implies (blocking) memcpy
call hipCheck(hipMalloc(dx, source=hx))
! Solve A * x = b, in place: dx holds b on entry, x on exit
call rocblasCheck(rocblas_strsv(handle, uplo, transA, diag, m, dA, size(dA,1), dx, 1))
call hipCheck(hipDeviceSynchronize())
! Transfer data back to host memory
call hipCheck(hipMemcpy(hx, dx, hipMemcpyDeviceToHost))
do i = 1, m
error = abs((x_exact - hx(i))/x_exact)
if( error > error_max )then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " hx(", i, ") = ", hx(i)
call exit(1)
end if
end do
call hipCheck(hipFree(dA))
call hipCheck(hipFree(dx))
call rocblasCheck(rocblas_destroy_handle(handle))
deallocate(hA, hx)
write(*,*) "PASSED!"
end program rocblas_strsv_test
test/f2008/rocblas/dtrsv.f08, ctrsv.f08 and ztrsv.f08 cover the
remaining precisions.
Packed triangular solve#
rocblas_?tpsv solves the same problem as trsv, but the triangular
matrix is stored in packed form: only the referenced triangle is kept, in a
single one-dimensional array, which halves the memory footprint for large
matrices.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_stpsv_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer(kind(rocblas_fill_lower)), parameter :: uplo = rocblas_fill_lower
integer(kind(rocblas_operation_none)), parameter :: transA = rocblas_operation_none
integer(kind(rocblas_diagonal_non_unit)), parameter :: diag = rocblas_diagonal_non_unit
integer, parameter :: n = 64
! Packed lower-triangular matrix (column-by-column). Every stored element of an
! all-ones lower-triangular matrix is 1, so the packing order is irrelevant here.
real(c_float), allocatable, dimension(:) :: hAP, hx
real(c_float), parameter :: x_exact = 1.0
real(c_float), pointer, dimension(:) :: dAP => null(), dx => null()
type(c_ptr) :: handle = c_null_ptr
integer :: i
real(c_float) :: error
real(c_float), parameter :: error_max = 10*epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'STPSV' (Fortran 2008 interfaces) - "
call rocblasCheck(rocblas_create_handle(handle))
allocate(hAP(n*(n+1)/2), hx(n))
hAP(:) = 1.0 ! all-ones lower-triangular L, packed
do i = 1, n
hx(i) = real(i) ! b(i) = i -> exact solution of L x = b is x(i) = 1
end do
! Allocate device memory (source= implies a blocking memcpy)
call hipCheck(hipMalloc(dAP, source=hAP))
call hipCheck(hipMalloc(dx, source=hx))
! Packed triangular solve L x = b, in place. dAP is passed as a Fortran array
! (the generic array form) — this is the case that used to fail to compile
! because the packed matrix dummy was declared type(c_ptr) (SWDEV-485451).
call rocblasCheck(rocblas_stpsv(handle, uplo, transA, diag, n, dAP, dx, 1))
call hipCheck(hipDeviceSynchronize())
call hipCheck(hipMemcpy(hx, dx, hipMemcpyDeviceToHost))
do i = 1, n
error = abs((x_exact - hx(i))/x_exact)
if( error > error_max )then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " hx(", i, ") = ", hx(i)
call exit(1)
end if
end do
call hipCheck(hipFree(dAP))
call hipCheck(hipFree(dx))
call rocblasCheck(rocblas_destroy_handle(handle))
deallocate(hAP, hx)
write(*,*) "PASSED!"
end program rocblas_stpsv_test
This is the only packed-storage example; there is no double-precision or complex counterpart in the test suite.
Level 3: matrix-matrix operations#
Matrix-matrix multiplication#
rocblas_?gemm computes C := alpha * op(A) * op(B) + beta * C. As with
gemv, this example uses constant matrix entries so the exact result is a
constant matrix.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_dgemm_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer(kind(rocblas_operation_none)), parameter :: transa = rocblas_operation_none, &
transb = rocblas_operation_none
double precision, parameter :: alpha = 1.1d0, beta = 0.9d0
integer, parameter :: m = 1024, n = 1024, k = 1024
double precision, allocatable, dimension(:,:) :: ha, hb, hc, hc_exact
double precision, pointer, dimension(:,:) :: da, db, dc
type(c_ptr) :: handle = c_null_ptr
integer :: i, j
double precision :: error
double precision, parameter :: error_max = 10*epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'DGEMM' (Fortran 2008 interfaces) - "
! Create rocblas handle and set host pointer mode for host alpha/beta
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0))
allocate(ha(m,k))
allocate(hb(k,n))
allocate(hc(m,n))
allocate(hc_exact(m,n))
! Use these constant matrices so the exact answer is also a
! constant matrix and therefore easy to check
ha(:,:) = 1.d0
hb(:,:) = 2.d0
hc(:,:) = 3.d0
hc_exact = alpha*k*2.d0 + beta*3.d0
! Allocate device memory
call hipCheck(hipMalloc(da,source=ha)) ! implies (blocking) memcpy
call hipCheck(hipMalloc(db,source=hb))
call hipCheck(hipMalloc(dc,source=hc))
call rocblasCheck(rocblas_dgemm(handle,transa,transb,m,n,k,alpha,da,size(da,1),db,size(db,1),beta,dc,size(dc,1)))
call hipCheck(hipDeviceSynchronize())
! Transfer data back to host memory
call hipCheck(hipMemcpy(hc, dc, hipMemcpyDeviceToHost))
do j = 1,n
do i = 1,m
error = abs((hc_exact(i,j) - hc(i,j))/hc_exact(i,j))
if( error > error_max )then
write(*,*) "FAILED! Error bigger than max! Error = ", error
call exit(1)
end if
end do
end do
call hipCheck(hipFree(da))
call hipCheck(hipFree(db))
call hipCheck(hipFree(dc))
call rocblasCheck(rocblas_destroy_handle(handle))
deallocate(ha,hb,hc,hc_exact)
write(*,*) "PASSED!"
end program rocblas_dgemm_test
test/f2008/rocblas/sgemm.f08, cgemm.f08 and zgemm.f08 cover the
remaining precisions.
Batched matrix multiplication#
rocblas_?gemm_batched runs several independent gemm calls in one
launch, with A, B and C each passed as a device array of device
pointers. hipFORT’s Fortran 2008 pointer-convenience interfaces cannot be used
for this argument shape: passing a plain array would only give rocBLAS a
single pointer, not the array of device pointers the routine requires. This
test therefore builds the pointer array with the same type(c_ptr) idiom
used in the Fortran 2003 interfaces, and only the per-batch device allocations
use the Fortran 2008 hipMalloc(source=...) shortcut.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Note: hipfort's Fortran 2008 pointer-convenience interfaces for
! rocblas_?gemm_batched call c_loc() on a plain array and therefore pass a
! single pointer, not the array of device pointers the routine requires. This
! test consequently uses the type(c_ptr) array-of-pointers idiom (as in f2003);
! only the per-batch device allocation uses the f2008 hipMalloc(source=) style.
program rocblas_dgemm_batched_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer(kind(rocblas_operation_none)), parameter :: transa = rocblas_operation_none, &
transb = rocblas_operation_none
double precision, parameter :: alpha = 1.1d0, beta = 0.9d0
integer, parameter :: m = 512, n = 512, k = 512, batch_count = 4
integer, parameter :: bytes_per_element = 8 ! double precision
integer, parameter :: size_a = m*k, size_b = k*n, size_c = m*n
integer(c_size_t), parameter :: Ncbytes = size_c*bytes_per_element
integer :: lda, ldb, ldc, i, b
double precision, allocatable, target, dimension(:,:) :: ha, hb, hc ! (elems, batch)
double precision, allocatable, dimension(:) :: hc_exact ! one value per batch
! Per-batch device matrices as typed Fortran pointers (reused each iteration)
double precision, pointer, dimension(:) :: da_b, db_b, dc_b
! Host arrays of device pointers (one device matrix per batch entry)
type(c_ptr), target :: da(batch_count), db(batch_count), dc(batch_count)
! Device-resident pointer arrays passed to the batched routine
type(c_ptr) :: da_p = c_null_ptr, db_p = c_null_ptr, dc_p = c_null_ptr
type(c_ptr) :: handle = c_null_ptr
double precision :: error
double precision, parameter :: error_max = 10*epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'DGEMM_BATCHED' (Fortran 2008 interfaces) - "
! Create rocblas handle and set host pointer mode for host alpha/beta
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0))
lda = m; ldb = k; ldc = m
allocate(ha(size_a,0:batch_count-1))
allocate(hb(size_b,0:batch_count-1))
allocate(hc(size_c,0:batch_count-1))
allocate(hc_exact(0:batch_count-1))
! Constant matrices with a distinct per-batch value so the exact answer is
! a distinct constant per batch. A is held constant; B varies per batch.
ha(:,:) = 1.d0
do b = 0, batch_count-1
hb(:,b) = dble(b+1)
hc(:,b) = 3.d0
hc_exact(b) = alpha*k*dble(b+1) + beta*3.d0
end do
! Allocate one device matrix per batch entry (f2008 source= copy) and record
! its device address in the host pointer array
do b = 1, batch_count
call hipCheck(hipMalloc(da_b,source=ha(:,b-1)))
call hipCheck(hipMalloc(db_b,source=hb(:,b-1)))
call hipCheck(hipMalloc(dc_b,source=hc(:,b-1)))
da(b) = c_loc(da_b(1))
db(b) = c_loc(db_b(1))
dc(b) = c_loc(dc_b(1))
end do
! Allocate the device-resident pointer arrays and copy the host pointer
! arrays into them (rocBLAS requires the pointer array in device memory)
call hipCheck(hipMalloc(da_p, int(batch_count,c_size_t)*c_sizeof(da(1))))
call hipCheck(hipMalloc(db_p, int(batch_count,c_size_t)*c_sizeof(db(1))))
call hipCheck(hipMalloc(dc_p, int(batch_count,c_size_t)*c_sizeof(dc(1))))
call hipCheck(hipMemcpy(da_p, c_loc(da(1)), int(batch_count,c_size_t)*c_sizeof(da(1)), hipMemcpyHostToDevice))
call hipCheck(hipMemcpy(db_p, c_loc(db(1)), int(batch_count,c_size_t)*c_sizeof(db(1)), hipMemcpyHostToDevice))
call hipCheck(hipMemcpy(dc_p, c_loc(dc(1)), int(batch_count,c_size_t)*c_sizeof(dc(1)), hipMemcpyHostToDevice))
call rocblasCheck(rocblas_dgemm_batched(handle,transa,transb,m,n,k, &
alpha,da_p,lda,db_p,ldb,beta,dc_p,ldc,batch_count))
call hipCheck(hipDeviceSynchronize())
! Transfer each batch result back to host memory
do b = 1, batch_count
call hipCheck(hipMemcpy(c_loc(hc(1,b-1)), dc(b), Ncbytes, hipMemcpyDeviceToHost))
end do
do b = 0, batch_count-1
do i = 1, size_c
error = abs((hc_exact(b) - hc(i,b))/hc_exact(b))
if( error > error_max )then
write(*,*) "FAILED! Error bigger than max! batch = ", b, " error = ", error
call exit(1)
end if
end do
end do
do b = 1, batch_count
call hipCheck(hipFree(da(b)))
call hipCheck(hipFree(db(b)))
call hipCheck(hipFree(dc(b)))
end do
call hipCheck(hipFree(da_p))
call hipCheck(hipFree(db_p))
call hipCheck(hipFree(dc_p))
call rocblasCheck(rocblas_destroy_handle(handle))
deallocate(ha)
deallocate(hb)
deallocate(hc)
deallocate(hc_exact)
write(*,*) "PASSED!"
end program rocblas_dgemm_batched_test
test/f2008/rocblas/sgemm_batched.f08, cgemm_batched.f08 and
zgemm_batched.f08 cover the remaining precisions.
Strided-batched matrix multiplication#
rocblas_?gemm_strided_batched also runs several gemm calls in one
launch, but A, B and C are contiguous device arrays with a fixed
stride between the start of each batch’s matrix, instead of an array of
pointers. This is usually simpler to set up than gemm_batched when the
batches are already laid out contiguously in memory.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_dgemm_strided_batched_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer(kind(rocblas_operation_none)), parameter :: transa = rocblas_operation_none, &
transb = rocblas_operation_none
double precision, parameter :: alpha = 1.1d0, beta = 0.9d0
integer, parameter :: m = 512, n = 512, k = 512, batch_count = 4
integer :: lda, ldb, ldc, i, b
integer(c_int64_t) :: stride_a, stride_b, stride_c
integer :: size_a, size_b, size_c
double precision, allocatable, dimension(:) :: ha, hb, hc
double precision, allocatable, dimension(:) :: hc_exact ! one value per batch
double precision, pointer, dimension(:) :: da, db, dc
type(c_ptr) :: handle = c_null_ptr
double precision :: error
double precision, parameter :: error_max = 10*epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'DGEMM_STRIDED_BATCHED' (Fortran 2008 interfaces) - "
! Create rocblas handle and set host pointer mode for host alpha/beta
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0))
lda = m; ldb = k; ldc = m
stride_a = int(lda,c_int64_t)*k
stride_b = int(ldb,c_int64_t)*n
stride_c = int(ldc,c_int64_t)*n
size_a = int(stride_a)*batch_count
size_b = int(stride_b)*batch_count
size_c = int(stride_c)*batch_count
allocate(ha(size_a))
allocate(hb(size_b))
allocate(hc(size_c))
allocate(hc_exact(0:batch_count-1))
! Constant matrices with a distinct per-batch value so the exact answer is
! a distinct constant per batch. A is held constant; B varies per batch.
ha(:) = 1.d0
do b = 0, batch_count-1
hb(b*stride_b+1 : (b+1)*stride_b) = dble(b+1)
hc(b*stride_c+1 : (b+1)*stride_c) = 3.d0
hc_exact(b) = alpha*k*dble(b+1) + beta*3.d0
end do
! Allocate device memory
call hipCheck(hipMalloc(da,source=ha)) ! implies (blocking) memcpy
call hipCheck(hipMalloc(db,source=hb))
call hipCheck(hipMalloc(dc,source=hc))
call rocblasCheck(rocblas_dgemm_strided_batched(handle,transa,transb,m,n,k, &
alpha,da,lda,stride_a,db,ldb,stride_b,beta,dc,ldc,stride_c,batch_count))
call hipCheck(hipDeviceSynchronize())
! Transfer data back to host memory
call hipCheck(hipMemcpy(hc, dc, hipMemcpyDeviceToHost))
do b = 0, batch_count-1
do i = 1, int(stride_c)
error = abs((hc_exact(b) - hc(b*stride_c+i))/hc_exact(b))
if( error > error_max )then
write(*,*) "FAILED! Error bigger than max! batch = ", b, " error = ", error
call exit(1)
end if
end do
end do
call hipCheck(hipFree(da))
call hipCheck(hipFree(db))
call hipCheck(hipFree(dc))
call rocblasCheck(rocblas_destroy_handle(handle))
deallocate(ha)
deallocate(hb)
deallocate(hc)
deallocate(hc_exact)
write(*,*) "PASSED!"
end program rocblas_dgemm_strided_batched_test
test/f2008/rocblas/sgemm_strided_batched.f08,
cgemm_strided_batched.f08 and zgemm_strided_batched.f08 cover the
remaining precisions.
Triangular matrix multiplication#
rocblas_?trmm computes C := alpha * op(A) * B (or the mirrored
right-hand form), where A is triangular. This example exercises the
out-of-place, 14-argument form of the interface, which writes the result to a
separate C buffer instead of overwriting B.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2022 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_dtrmm_test
! Exercises the out-of-place (14-argument) rocblas_?trmm interface:
!
! C := alpha * op(A) * B (side = left)
!
! With A an m-by-m lower-triangular matrix whose referenced entries are
! all 1, B all 2 and alpha = 1, the exact result is C(i,j) = 2*i, which
! is integer-valued in double precision and therefore checkable exactly.
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
use hipfort_rocblas_enums
implicit none
integer, parameter :: m = 512, n = 512
real(c_double) :: alpha = 1.0d0
real(c_double), allocatable, target, dimension(:,:) :: hA, hB, hC, hC_exact
real(c_double), pointer, dimension(:,:) :: dA, dB, dC
type(c_ptr) :: handle = c_null_ptr
integer :: i, j
real(c_double) :: error
real(c_double), parameter :: error_max = 10 * epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'dtrmm' (Fortran 2008 interfaces) - "
call rocblasCheck(rocblas_create_handle(handle))
allocate(hA(m,m))
allocate(hB(m,n))
allocate(hC(m,n))
allocate(hC_exact(m,n))
! Lower-triangular A (strictly upper part is not referenced by rocBLAS)
hA(:,:) = 0.0d0
do j = 1, m
do i = j, m
hA(i,j) = 1.0d0
end do
end do
hB(:,:) = 2.0d0
hC(:,:) = -1.0d0 ! poison: must be fully overwritten by the output
do j = 1, n
do i = 1, m
hC_exact(i,j) = alpha * 2.0d0 * i
end do
end do
! Allocate device memory (source= implies a blocking memcpy)
call hipCheck(hipMalloc(dA, source=hA))
call hipCheck(hipMalloc(dB, source=hB))
call hipCheck(hipMalloc(dC, source=hC))
call rocblasCheck(rocblas_set_pointer_mode(handle, rocblas_pointer_mode_host))
call rocblasCheck(rocblas_dtrmm(handle, rocblas_side_left, rocblas_fill_lower, &
rocblas_operation_none, rocblas_diagonal_non_unit, m, n, alpha, &
dA, size(dA,1), dB, size(dB,1), dC, size(dC,1)))
call hipCheck(hipDeviceSynchronize())
! Transfer data back to host memory
call hipCheck(hipMemcpy(hC, dC, hipMemcpyDeviceToHost))
! Verification
do j = 1, n
do i = 1, m
error = abs((hC_exact(i,j) - hC(i,j)) / hC_exact(i,j))
if (error > error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, &
" hC(", i, ",", j, ") = ", hC(i,j)
call exit(1)
end if
end do
end do
! Cleanup
call hipCheck(hipFree(dA))
call hipCheck(hipFree(dB))
call hipCheck(hipFree(dC))
deallocate(hA, hB, hC, hC_exact)
call rocblasCheck(rocblas_destroy_handle(handle))
write(*,*) "PASSED!"
end program rocblas_dtrmm_test
dtrmm is the only trmm example among the rocBLAS programs.
Triangular solve with multiple right-hand sides#
rocblas_?trsm solves A * X = alpha * B in place for a triangular
matrix A and a matrix of right-hand sides B, which is the gemm-like
counterpart of trsv. dB holds B on entry and the solution X on
exit.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_dtrsm_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
integer(kind(rocblas_side_left)), parameter :: side = rocblas_side_left
integer(kind(rocblas_fill_lower)), parameter :: uplo = rocblas_fill_lower
integer(kind(rocblas_operation_none)), parameter :: transA = rocblas_operation_none
integer(kind(rocblas_diagonal_non_unit)), parameter :: diag = rocblas_diagonal_non_unit
integer, parameter :: m = 1024, n = 1024
double precision, allocatable, dimension(:,:) :: hA, hB
double precision, parameter :: alpha = 2.d0
double precision, parameter :: x_exact = 1.d0
double precision, pointer, dimension(:,:) :: dA, dB
type(c_ptr) :: handle = c_null_ptr
integer :: i, j
double precision :: error
double precision, parameter :: error_max = 10*epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'DTRSM' (Fortran 2008 interfaces) - "
! Create rocblas handle and set host pointer mode for host alpha
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0))
allocate(hA(m,m), hB(m,n))
! Lower-triangular A with all ones on/below the diagonal; upper part zeroed
hA(:,:) = 0.d0
do j = 1, m
do i = j, m
hA(i,j) = 1.d0
end do
end do
! RHS B(i,j) = i/2 = alpha^-1 * i -> exact solution X(i,j) = 1
do j = 1, n
do i = 1, m
hB(i,j) = dble(i) / 2.d0
end do
end do
! Allocate device memory
call hipCheck(hipMalloc(dA, source=hA)) ! implies (blocking) memcpy
call hipCheck(hipMalloc(dB, source=hB))
! Solve A * X = alpha * B, in place: dB holds B on entry, X on exit
call rocblasCheck(rocblas_dtrsm(handle, side, uplo, transA, diag, m, n, alpha, dA, size(dA,1), dB, size(dB,1)))
call hipCheck(hipDeviceSynchronize())
! Transfer data back to host memory
call hipCheck(hipMemcpy(hB, dB, hipMemcpyDeviceToHost))
do j = 1, n
do i = 1, m
error = abs((x_exact - hB(i,j))/x_exact)
if( error > error_max )then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " hB(", i, ",", j, ") = ", hB(i,j)
call exit(1)
end if
end do
end do
call hipCheck(hipFree(dA))
call hipCheck(hipFree(dB))
call rocblasCheck(rocblas_destroy_handle(handle))
deallocate(hA, hB)
write(*,*) "PASSED!"
end program rocblas_dtrsm_test
test/f2008/rocblas/strsm.f08, ctrsm.f08 and ztrsm.f08 cover the
remaining precisions.
Rank-k update (syrk and herk)#
rocblas_?syrk computes C := alpha * op(A) * op(A)**T + beta * C, where
C is symmetric and only the triangle chosen by the fill mode is
referenced.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_ssyrk_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
! C := alpha*A*A**T + beta*C, upper triangle. With
! A = [1 0; 2 3] (column-major below), alpha = 1, beta = 0
! the product is [1 2; 2 13], so the stored upper triangle is
! C(1,1)=1, C(1,2)=2, C(2,2)=13. The data is real-valued, so the
! symmetric and Hermitian forms agree.
integer, parameter :: n = 2, k = 2
real(c_float), parameter :: alpha = 1.0, beta = 0.0
real(c_float) :: hA(n,k) = reshape([1.0, 2.0, 0.0, 3.0], [n,k])
real(c_float) :: hC(n,n)
real(c_float) :: expected(n,n) = reshape([1.0, 0.0, 2.0, 13.0], [n,n])
real(c_float), pointer, dimension(:,:) :: dA, dC
type(c_ptr) :: handle = c_null_ptr
integer :: i, j
real(c_float) :: error
real(c_float), parameter :: error_max = 10 * epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'ssyrk' (Fortran 2008 interfaces) - "
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0)) ! host pointer mode
hC = 0.0
call hipCheck(hipMalloc(dA, source=hA))
call hipCheck(hipMalloc(dC, source=hC))
call rocblasCheck(rocblas_ssyrk(handle, rocblas_fill_upper, rocblas_operation_none, &
n, k, alpha, dA, size(dA,1), beta, dC, size(dC,1)))
call hipCheck(hipDeviceSynchronize())
call hipCheck(hipMemcpy(hC, dC, hipMemcpyDeviceToHost))
! only the upper triangle is referenced/written
do j = 1, n
do i = 1, j
error = abs(expected(i,j) - hC(i,j))
if (error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " at ", i, j
call exit(1)
end if
end do
end do
call hipCheck(hipFree(dA))
call hipCheck(hipFree(dC))
call rocblasCheck(rocblas_destroy_handle(handle))
write(*,*) "PASSED!"
end program rocblas_ssyrk_test
test/f2008/rocblas/dsyrk.f08, csyrk.f08 and zsyrk.f08 cover the
remaining precisions. For complex data there is also a Hermitian form,
rocblas_?herk, which uses A * A**H and produces a matrix with a real
diagonal; see cherk.f08 and zherk.f08.
Symmetric and Hermitian matrix product (symm and hemm)#
rocblas_?symm computes C := alpha * A * B + beta * C with A
symmetric, or the mirrored right-hand form selected by the side argument.
As with syrk, only one triangle of A is referenced.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_ssymm_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
! C := alpha*A*B + beta*C with A symmetric (upper triangle referenced).
! A = [1 2; 2 3], B = I, alpha = 1, beta = 0, so C = A. The data is
! real-valued, so the symmetric and Hermitian forms agree.
integer, parameter :: m = 2, n = 2
real(c_float), parameter :: alpha = 1.0, beta = 0.0
real(c_float) :: hA(m,m) = reshape([1.0, 2.0, 2.0, 3.0], [m,m])
real(c_float) :: hB(m,n) = reshape([1.0, 0.0, 0.0, 1.0], [m,n])
real(c_float) :: hC(m,n)
real(c_float) :: expected(m,n) = reshape([1.0, 2.0, 2.0, 3.0], [m,n])
real(c_float), pointer, dimension(:,:) :: dA, dB, dC
type(c_ptr) :: handle = c_null_ptr
integer :: i, j
real(c_float) :: error
real(c_float), parameter :: error_max = 10 * epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'ssymm' (Fortran 2008 interfaces) - "
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0)) ! host pointer mode
hC = 0.0
call hipCheck(hipMalloc(dA, source=hA))
call hipCheck(hipMalloc(dB, source=hB))
call hipCheck(hipMalloc(dC, source=hC))
call rocblasCheck(rocblas_ssymm(handle, rocblas_side_left, rocblas_fill_upper, m, n, &
alpha, dA, size(dA,1), dB, size(dB,1), beta, dC, size(dC,1)))
call hipCheck(hipDeviceSynchronize())
call hipCheck(hipMemcpy(hC, dC, hipMemcpyDeviceToHost))
do j = 1, n
do i = 1, m
error = abs(expected(i,j) - hC(i,j))
if (error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " at ", i, j
call exit(1)
end if
end do
end do
call hipCheck(hipFree(dA))
call hipCheck(hipFree(dB))
call hipCheck(hipFree(dC))
call rocblasCheck(rocblas_destroy_handle(handle))
write(*,*) "PASSED!"
end program rocblas_ssymm_test
test/f2008/rocblas/dsymm.f08, csymm.f08 and zsymm.f08 cover the
remaining precisions, and rocblas_?hemm is the Hermitian form for complex
data; see chemm.f08 and zhemm.f08.
Matrix addition and transposition (geam)#
rocblas_?geam computes C := alpha * op(A) + beta * op(B). Because each
operand has its own transpose flag and either scalar may be zero, the same
routine also serves as an out-of-place transpose or a scaled copy.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_sgeam_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
! C := alpha*op(A) + beta*op(B), both non-transposed, alpha = beta = 1,
! so C is the elementwise sum A + B.
integer, parameter :: m = 2, n = 2
real(c_float), parameter :: alpha = 1.0, beta = 1.0
real(c_float) :: hA(m,n) = reshape([1.0, 2.0, 3.0, 4.0], [m,n])
real(c_float) :: hB(m,n) = reshape([10.0, 20.0, 30.0, 40.0], [m,n])
real(c_float) :: hC(m,n)
real(c_float) :: expected(m,n) = reshape([11.0, 22.0, 33.0, 44.0], [m,n])
real(c_float), pointer, dimension(:,:) :: dA, dB, dC
type(c_ptr) :: handle = c_null_ptr
integer :: i, j
real(c_float) :: error
real(c_float), parameter :: error_max = 10 * epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'sgeam' (Fortran 2008 interfaces) - "
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0)) ! host pointer mode
hC = 0.0
call hipCheck(hipMalloc(dA, source=hA))
call hipCheck(hipMalloc(dB, source=hB))
call hipCheck(hipMalloc(dC, source=hC))
call rocblasCheck(rocblas_sgeam(handle, rocblas_operation_none, rocblas_operation_none, m, n, &
alpha, dA, size(dA,1), beta, dB, size(dB,1), dC, size(dC,1)))
call hipCheck(hipDeviceSynchronize())
call hipCheck(hipMemcpy(hC, dC, hipMemcpyDeviceToHost))
do j = 1, n
do i = 1, m
error = abs(expected(i,j) - hC(i,j))
if (error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " at ", i, j
call exit(1)
end if
end do
end do
call hipCheck(hipFree(dA))
call hipCheck(hipFree(dB))
call hipCheck(hipFree(dC))
call rocblasCheck(rocblas_destroy_handle(handle))
write(*,*) "PASSED!"
end program rocblas_sgeam_test
test/f2008/rocblas/dgeam.f08, cgeam.f08 and zgeam.f08 cover the
remaining precisions.
Extended-precision matrix multiplication (gemm_ex)#
rocblas_gemm_ex computes D := alpha * op(A) * op(B) + beta * C with the
type of every buffer, and the type used for the arithmetic, given explicitly as
rocblas_datatype_* arguments. That makes it the entry point for mixed
precision work, and it writes to a separate D rather than overwriting
C. A rocblas_gemm_algo_* argument selects the algorithm. This example
keeps every buffer and the compute type at rocblas_datatype_f32_r, so it
performs an ordinary single-precision gemm.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2020-2026 Advanced Micro Devices, Inc.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
program rocblas_gemm_ex_test
use iso_c_binding
use hipfort
use hipfort_check
use hipfort_rocblas
implicit none
! D := alpha*op(A)*op(B) + beta*C through the extended-precision entry point.
! All buffers are f32_r and the compute type is f32_r. With A = I, alpha = 1
! and beta = 0 the result is D = B.
integer, parameter :: m = 2, n = 2, k = 2
real(c_float), target :: alpha = 1.0, beta = 0.0
real(c_float) :: hA(m,k) = reshape([1.0, 0.0, 0.0, 1.0], [m,k])
real(c_float) :: hB(k,n) = reshape([1.0, 2.0, 3.0, 4.0], [k,n])
real(c_float) :: hC(m,n)
real(c_float) :: hD(m,n)
real(c_float) :: expected(m,n) = reshape([1.0, 2.0, 3.0, 4.0], [m,n])
real(c_float), pointer, dimension(:,:) :: dA, dB, dC, dD
type(c_ptr) :: handle = c_null_ptr
integer :: i, j
real(c_float) :: error
real(c_float), parameter :: error_max = 10 * epsilon(error)
write(*,"(a)",advance="no") "-- Running test 'gemm_ex' (Fortran 2008 interfaces) - "
call rocblasCheck(rocblas_create_handle(handle))
call rocblasCheck(rocblas_set_pointer_mode(handle, 0)) ! host pointer mode
hC = 0.0
hD = 0.0
call hipCheck(hipMalloc(dA, source=hA))
call hipCheck(hipMalloc(dB, source=hB))
call hipCheck(hipMalloc(dC, source=hC))
call hipCheck(hipMalloc(dD, source=hD))
call rocblasCheck(rocblas_gemm_ex(handle, rocblas_operation_none, rocblas_operation_none, &
m, n, k, c_loc(alpha), c_loc(dA(1,1)), rocblas_datatype_f32_r, m, &
c_loc(dB(1,1)), rocblas_datatype_f32_r, k, c_loc(beta), &
c_loc(dC(1,1)), rocblas_datatype_f32_r, m, &
c_loc(dD(1,1)), rocblas_datatype_f32_r, m, &
rocblas_datatype_f32_r, rocblas_gemm_algo_standard, 0, 0))
call hipCheck(hipDeviceSynchronize())
call hipCheck(hipMemcpy(hD, dD, hipMemcpyDeviceToHost))
do j = 1, n
do i = 1, m
error = abs(expected(i,j) - hD(i,j))
if (error .gt. error_max) then
write(*,*) "FAILED! Error bigger than max! Error = ", error, " at ", i, j
call exit(1)
end if
end do
end do
call hipCheck(hipFree(dA))
call hipCheck(hipFree(dB))
call hipCheck(hipFree(dC))
call hipCheck(hipFree(dD))
call rocblasCheck(rocblas_destroy_handle(handle))
write(*,*) "PASSED!"
end program rocblas_gemm_ex_test
Because the buffer types are runtime arguments rather than part of the routine
name, there is a single gemm_ex program rather than one per precision.