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
238 lines
7.7 KiB
Fortran
238 lines
7.7 KiB
Fortran
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
! Copyright (C) 2021 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_gtsv
|
|
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
|
|
|
|
real(8), target :: h_dl(10), h_d(10), h_du(10), h_B(20)
|
|
|
|
type(c_ptr) :: d_dl
|
|
type(c_ptr) :: d_d
|
|
type(c_ptr) :: d_du
|
|
type(c_ptr) :: d_B
|
|
type(c_ptr) :: temp_buffer
|
|
|
|
integer :: i, j, k
|
|
integer(c_int) :: M, N, ldb
|
|
integer(c_int) :: stat
|
|
integer(c_size_t), target :: buffer_size
|
|
|
|
type(c_ptr) :: handle
|
|
|
|
integer :: version
|
|
|
|
character(len=12) :: rev
|
|
|
|
! Input data
|
|
|
|
! ( 1 1 0 0 0 0 0 0 0 0 )
|
|
! ( 1 1 1 0 0 0 0 0 0 0 )
|
|
! ( 0 1 1 1 0 0 0 0 0 0 )
|
|
! ( 0 0 1 1 1 0 0 0 0 0 )
|
|
! A = ( 0 0 0 1 1 1 0 0 0 0 )
|
|
! ( 0 0 0 0 1 1 1 0 0 0 )
|
|
! ( 0 0 0 0 0 1 1 1 0 0 )
|
|
! ( 0 0 0 0 0 0 1 1 1 0 )
|
|
! ( 0 0 0 0 0 0 0 1 1 1 )
|
|
! ( 0 0 0 0 0 0 0 0 1 1 )
|
|
!
|
|
! ( 1 1 )
|
|
! ( 2 1 )
|
|
! ( 4 1 )
|
|
! ( 4 0 )
|
|
! B = ( 4 1 )
|
|
! ( 6 0 )
|
|
! ( 4 5 )
|
|
! ( 2 3 )
|
|
! ( 1 2 )
|
|
! ( 1 4 )
|
|
|
|
! Number of rows and columns
|
|
M = 10
|
|
N = 2
|
|
ldb = M
|
|
|
|
! Fill tri-diagonal arrays
|
|
h_dl = (/0, 1, 1, 1, 1, 1, 1, 1, 1, 1/)
|
|
h_d = (/1, 1, 1, 1, 1, 1, 1, 1, 1, 1/)
|
|
h_du = (/1, 1, 1, 1, 1, 1, 1, 1, 1, 0/)
|
|
h_B = (/1, 2, 4, 4, 4, 6, 4, 2, 1, 1, 1, 1, 1, 0, 1, 0, 5, 3, 2, 4/)
|
|
|
|
! Allocate device memory
|
|
call HIP_CHECK(hipMalloc(d_dl, int(M, c_size_t) * 8))
|
|
call HIP_CHECK(hipMalloc(d_d, int(M, c_size_t) * 8))
|
|
call HIP_CHECK(hipMalloc(d_du, int(M, c_size_t) * 8))
|
|
call HIP_CHECK(hipMalloc(d_B, int(M, c_size_t) * int(N, c_size_t) * 8))
|
|
|
|
! Copy host data to device
|
|
call HIP_CHECK(hipMemcpy(d_dl, c_loc(h_dl), int(M, c_size_t) * 8, 1))
|
|
call HIP_CHECK(hipMemcpy(d_d, c_loc(h_d), int(M, c_size_t) * 8, 1))
|
|
call HIP_CHECK(hipMemcpy(d_du, c_loc(h_du), int(M, c_size_t) * 8, 1))
|
|
call HIP_CHECK(hipMemcpy(d_B, c_loc(h_B), int(M, c_size_t) * int(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
|
|
|
|
! Obtain required buffer size
|
|
call ROCSPARSE_CHECK(rocsparse_dgtsv_buffer_size(handle, &
|
|
M, &
|
|
N, &
|
|
d_dl, &
|
|
d_d, &
|
|
d_du, &
|
|
d_B, &
|
|
ldb, &
|
|
c_loc(buffer_size)))
|
|
|
|
! Allocate temporary buffer
|
|
write(*,fmt='(A,I0,A)') 'Allocating ', buffer_size / 1024, 'kB temporary storage buffer'
|
|
|
|
call HIP_CHECK(hipMalloc(temp_buffer, buffer_size))
|
|
|
|
! Call dgtsv to perform tri-diagonal solve
|
|
call ROCSPARSE_CHECK(rocsparse_dgtsv(handle, &
|
|
M, &
|
|
N, &
|
|
d_dl, &
|
|
d_d, &
|
|
d_du, &
|
|
d_B, &
|
|
ldb, &
|
|
temp_buffer))
|
|
|
|
! Print result
|
|
call HIP_CHECK(hipMemcpy(c_loc(h_B), d_B, int(M, c_size_t) * int(N, c_size_t) * 8, 2))
|
|
|
|
! write(*,fmt='(A)') "Tri-diagonal solve:"
|
|
do i = 1, N
|
|
do j = 1, M
|
|
write(*,fmt='(A,I0,A,F0.2)') 'B(', j, ') = ', h_B(ldb * (i - 1) + j)
|
|
end do
|
|
write(*,*)
|
|
end do
|
|
|
|
! Clear rocSPARSE
|
|
call ROCSPARSE_CHECK(rocsparse_destroy_handle(handle))
|
|
|
|
! Clear device memory
|
|
call HIP_CHECK(hipFree(d_dl))
|
|
call HIP_CHECK(hipFree(d_d))
|
|
call HIP_CHECK(hipFree(d_du))
|
|
call HIP_CHECK(hipFree(d_B))
|
|
call HIP_CHECK(hipFree(temp_buffer))
|
|
|
|
end program example_fortran_gtsv
|