derek.holloway
7502bf64a4
CodeQL / Analyze (actions) (push) Canceled after 0s
CodeQL / Analyze (python) (push) Canceled after 0s
pre-commit / pre-commit (push) Canceled after 0s
Multi-Arch CI / setup (push) Canceled after 0s
Publish build_manylinux_x86_64 images / publish_build_manylinux_x86_64 (push) Canceled after 0s
Setup (Multi-Arch) / setup (push) Canceled after 0s
Multi-Arch CI / Linux::${{ fromJSON(needs.setup.outputs.linux_build_config || '{}').build_variant_label || 'skip' }} (push) Canceled after 0s
Publish TheRock Docker image / build-and-push-image (push) Canceled after 0s
Publish no_rocm_image_ubi10 image / publish_no_rocm_image_ubi10 (push) Canceled after 0s
Multi-Arch CI / Windows::${{ fromJSON(needs.setup.outputs.windows_build_config || '{}').build_variant_label || 'skip' }} (push) Canceled after 0s
Publish TheRock Docker image / build-and-push-image (push) Canceled after 0s
Multi-Arch CI / Manifest Diff (push) Canceled after 0s
TheRock Manifest Diff Report / Generate Manifest Diff Report (push) Canceled after 0s
Multi-Arch CI / CI Summary (push) Canceled after 0s
Publish no_rocm_image_ubuntu24_04 images / publish_no_rocm_image_ubuntu24_04 (push) Canceled after 0s
Publish no_rocm_image_ubuntu24_04_ocl_rt images / publish_no_rocm_image_ubuntu24_04_ocl_rt (push) Canceled after 0s
Publish TheRock Docker image / build-and-push-image (push) Canceled after 0s
Publish TheRock Docker image / build-and-push-image (push) Canceled after 0s
Publish no_rocm_image_ubuntu24_04 images / publish_no_rocm_image_ubuntu24_04_rocgdb (push) Canceled after 0s
Publish no_rocm_image_ubuntu24_04_rocgdb images / publish_no_rocm_image_ubuntu24_04_rocgdb (push) Canceled after 0s
Publish no_rocm_image_ubuntu24_04 images / publish_no_rocm_image_ubuntu24_04_ocl_rt (push) Canceled after 0s
Publish TheRock Docker image / build-and-push-image (push) Canceled after 0s
Unit Tests / Unit Tests :: ubuntu-24.04 (push) Canceled after 0s
Unit Tests / Unit Tests :: windows-2022 (push) Canceled after 0s
Publish no_rocm_image_ubuntu24_04 images / publish_no_rocm_image_ubuntu24_04_media (push) Canceled after 0s
Unit Tests / Unit Tests Summary (push) Canceled after 0s
Publish no_rocm_image_ubuntu24_04 images / publish_no_rocm_image_ubuntu24_04_openmpi (push) Canceled after 0s
262 lines
8.4 KiB
Fortran
262 lines
8.4 KiB
Fortran
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
! Copyright (C) 2020 Advanced Micro Devices, Inc. All rights Reserved.
|
|
!
|
|
! 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.
|
|
!
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
subroutine HIP_CHECK(stat)
|
|
use iso_c_binding
|
|
|
|
implicit none
|
|
|
|
integer(c_int) :: stat
|
|
|
|
if(stat /= 0) then
|
|
write(*,*) 'Error: hip error'
|
|
stop
|
|
end if
|
|
|
|
end subroutine HIP_CHECK
|
|
|
|
subroutine ROCSPARSE_CHECK(stat)
|
|
use iso_c_binding
|
|
|
|
implicit none
|
|
|
|
integer(c_int) :: stat
|
|
|
|
if(stat /= 0) then
|
|
write(*,*) 'Error: rocsparse error'
|
|
stop
|
|
end if
|
|
|
|
end subroutine ROCSPARSE_CHECK
|
|
|
|
program example_fortran_bsrmm
|
|
use iso_c_binding
|
|
use rocsparse
|
|
|
|
implicit none
|
|
|
|
interface
|
|
function hipMalloc(ptr, size) &
|
|
bind(c, name = 'hipMalloc')
|
|
use iso_c_binding
|
|
implicit none
|
|
integer :: hipMalloc
|
|
type(c_ptr) :: ptr
|
|
integer(c_size_t), value :: size
|
|
end function hipMalloc
|
|
|
|
function hipFree(ptr) &
|
|
bind(c, name = 'hipFree')
|
|
use iso_c_binding
|
|
implicit none
|
|
integer :: hipFree
|
|
type(c_ptr), value :: ptr
|
|
end function hipFree
|
|
|
|
function hipMemcpy(dst, src, size, kind) &
|
|
bind(c, name = 'hipMemcpy')
|
|
use iso_c_binding
|
|
implicit none
|
|
integer :: hipMemcpy
|
|
type(c_ptr), value :: dst
|
|
type(c_ptr), intent(in), value :: src
|
|
integer(c_size_t), value :: size
|
|
integer(c_int), value :: kind
|
|
end function hipMemcpy
|
|
|
|
function hipMemset(dst, val, size) &
|
|
bind(c, name = 'hipMemset')
|
|
use iso_c_binding
|
|
implicit none
|
|
integer :: hipMemset
|
|
type(c_ptr), value :: dst
|
|
integer(c_int), value :: val
|
|
integer(c_size_t), value :: size
|
|
end function hipMemset
|
|
|
|
function hipDeviceSynchronize() &
|
|
bind(c, name = 'hipDeviceSynchronize')
|
|
use iso_c_binding
|
|
implicit none
|
|
integer :: hipDeviceSynchronize
|
|
end function hipDeviceSynchronize
|
|
|
|
function hipDeviceReset() &
|
|
bind(c, name = 'hipDeviceReset')
|
|
use iso_c_binding
|
|
implicit none
|
|
integer :: hipDeviceReset
|
|
end function hipDeviceReset
|
|
end interface
|
|
|
|
integer, target :: h_bsr_row_ptr(3), h_bsr_col_ind(4)
|
|
real(8), target :: h_bsr_val(16), h_B(6 * 10), h_C(4 * 10)
|
|
|
|
type(c_ptr) :: d_bsr_row_ptr
|
|
type(c_ptr) :: d_bsr_col_ind
|
|
type(c_ptr) :: d_bsr_val
|
|
type(c_ptr) :: d_B
|
|
type(c_ptr) :: d_C
|
|
|
|
integer :: i, j
|
|
integer(c_int) :: M, Mb, N, K, Kb, nnzb, block_dim
|
|
|
|
real(c_double), target :: alpha, beta
|
|
|
|
type(c_ptr) :: handle
|
|
type(c_ptr) :: descr
|
|
|
|
integer :: version
|
|
|
|
character(len=12) :: rev
|
|
|
|
! Input data
|
|
! ( 1 2 0 3 0 0 )
|
|
! A = ( 0 4 5 0 0 0 )
|
|
! ( 0 0 0 7 8 0 )
|
|
! ( 0 0 1 2 4 1 )
|
|
|
|
! ( 9 11 13 15 17 10 12 14 16 18 )
|
|
! ( 8 10 1 10 6 11 7 3 12 17 )
|
|
! B = ( 11 11 0 4 6 12 2 9 13 2 )
|
|
! ( 15 3 2 3 8 1 2 4 6 6 )
|
|
! ( 2 5 7 0 1 15 9 4 10 1 )
|
|
! ( 7 12 12 1 12 5 1 11 1 14 )
|
|
|
|
! Number of rows and columns
|
|
block_dim = 2
|
|
Mb = 2
|
|
Kb = 3
|
|
N = 10
|
|
M = Mb * block_dim
|
|
K = Kb * block_dim
|
|
|
|
! Number of non-zero blocks
|
|
nnzb = 4
|
|
|
|
! Fill BSR structure
|
|
h_bsr_row_ptr = (/0, 2, 4/)
|
|
h_bsr_col_ind = (/0, 1, 1, 2/)
|
|
h_bsr_val = (/1, 2, 0, 4, 0, 3, 5, 0, 0, 7, 1, 2, 8, 0, 4, 1/)
|
|
|
|
! Scalar alpha and beta
|
|
alpha = 1.0
|
|
beta = 0.0
|
|
|
|
! Fill B in column-major
|
|
h_B = (/9, 8, 11, 15, 2, 7, &
|
|
11, 10, 11, 3, 5, 12, &
|
|
13, 1, 0, 2, 7, 12, &
|
|
15, 10, 4, 3, 0, 1, &
|
|
17, 6, 6, 8, 1, 12, &
|
|
10, 11, 12, 1, 15, 5, &
|
|
12, 7, 2, 2, 9, 1, &
|
|
14, 3, 9, 4, 4, 11, &
|
|
16, 12, 13, 6, 10, 1, &
|
|
18, 17, 2, 6, 1, 14/)
|
|
|
|
! Fill C in column-major
|
|
h_C = (/0, 0, 0, 0, &
|
|
0, 0, 0, 0, &
|
|
0, 0, 0, 0, &
|
|
0, 0, 0, 0, &
|
|
0, 0, 0, 0, &
|
|
0, 0, 0, 0, &
|
|
0, 0, 0, 0, &
|
|
0, 0, 0, 0, &
|
|
0, 0, 0, 0, &
|
|
0, 0, 0, 0/)
|
|
|
|
! Allocate device memory
|
|
call HIP_CHECK(hipMalloc(d_bsr_row_ptr, (int(Mb, c_size_t) + 1) * 4))
|
|
call HIP_CHECK(hipMalloc(d_bsr_col_ind, int(nnzb, c_size_t) * 4))
|
|
call HIP_CHECK(hipMalloc(d_bsr_val, int(nnzb * block_dim * block_dim, c_size_t) * 8))
|
|
call HIP_CHECK(hipMalloc(d_B, int(K * N, c_size_t) * 8))
|
|
call HIP_CHECK(hipMalloc(d_C, int(M * N, c_size_t) * 8))
|
|
|
|
! Copy host data to device
|
|
call HIP_CHECK(hipMemcpy(d_bsr_row_ptr, c_loc(h_bsr_row_ptr), (int(Mb, c_size_t) + 1) * 4, 1))
|
|
call HIP_CHECK(hipMemcpy(d_bsr_col_ind, c_loc(h_bsr_col_ind), int(nnzb, c_size_t) * 4, 1))
|
|
call HIP_CHECK(hipMemcpy(d_bsr_val, c_loc(h_bsr_val), int(nnzb * block_dim * block_dim, c_size_t) * 8, 1))
|
|
call HIP_CHECK(hipMemcpy(d_B, c_loc(h_B), int(K * N, c_size_t) * 8, 1))
|
|
call HIP_CHECK(hipMemcpy(d_C, c_loc(h_C), int(M * N, c_size_t) * 8, 1))
|
|
|
|
! Create rocSPARSE handle
|
|
call ROCSPARSE_CHECK(rocsparse_create_handle(handle))
|
|
|
|
! Get rocSPARSE version
|
|
call ROCSPARSE_CHECK(rocsparse_get_version(handle, version))
|
|
call ROCSPARSE_CHECK(rocsparse_get_git_rev(handle, rev))
|
|
|
|
! Print version on screen
|
|
write(*,fmt='(A,I0,A,I0,A,I0,A,A)') 'rocSPARSE version: ', version / 100000, '.', &
|
|
mod(version / 100, 1000), '.', mod(version, 100), '-', rev
|
|
|
|
! Create matrix descriptor
|
|
call ROCSPARSE_CHECK(rocsparse_create_mat_descr(descr))
|
|
|
|
! Perform the matrix multiplication
|
|
call ROCSPARSE_CHECK(rocsparse_dbsrmm(handle, &
|
|
rocsparse_direction_row, &
|
|
rocsparse_operation_none, &
|
|
rocsparse_operation_none, &
|
|
Mb, &
|
|
N, &
|
|
Kb, &
|
|
nnzb, &
|
|
c_loc(alpha), &
|
|
descr, &
|
|
d_bsr_val, &
|
|
d_bsr_row_ptr, &
|
|
d_bsr_col_ind, &
|
|
block_dim, &
|
|
d_B, &
|
|
K, &
|
|
c_loc(beta), &
|
|
d_C, &
|
|
M))
|
|
|
|
! Print result
|
|
call HIP_CHECK(hipMemcpy(c_loc(h_C), d_C, int(M * N, c_size_t) * 8, 2))
|
|
|
|
! Note: C in column major ordering
|
|
do i = 1, M
|
|
do j = 1, N
|
|
write(*,fmt='(A,F6.2)',advance='no') ' ', h_C(M * (j - 1) + i)
|
|
end do
|
|
write(*,*)
|
|
end do
|
|
|
|
! Clear rocSPARSE
|
|
call ROCSPARSE_CHECK(rocsparse_destroy_mat_descr(descr))
|
|
call ROCSPARSE_CHECK(rocsparse_destroy_handle(handle))
|
|
|
|
! Clear device memory
|
|
call HIP_CHECK(hipFree(d_bsr_row_ptr))
|
|
call HIP_CHECK(hipFree(d_bsr_col_ind))
|
|
call HIP_CHECK(hipFree(d_bsr_val))
|
|
call HIP_CHECK(hipFree(d_B))
|
|
call HIP_CHECK(hipFree(d_C))
|
|
|
|
end program example_fortran_bsrmm
|