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 reuses the rocBLAS handle type, so the patterns on this page carry
over to that library as well; rocSPARSE has its own rocsparse_handle.
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 version of each
program lives in test/f2008/rocblas. Most also have an equivalent Fortran
2003 version 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(1)
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.