! Parallel Sparse BLAS GPU plugin ! (C) Copyright 2013 ! ! Salvatore Filippone ! Alessandro Fanfarillo ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: ! 1. Redistributions of source code must retain the above copyright ! notice, this list of conditions and the following disclaimer. ! 2. Redistributions in binary form must reproduce the above copyright ! notice, this list of conditions, and the following disclaimer in the ! documentation and/or other materials provided with the distribution. ! 3. The name of the PSBLAS group or the names of its contributors may ! not be used to endorse or promote products derived from this ! software without specific written permission. ! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR ! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS ! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR ! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF ! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. ! #if CUDA_SHORT_VERSION <= 10 subroutine psb_z_cuda_hybg_to_gpu(a,info,nzrm) use psb_base_mod use cusparse_mod use psb_z_cuda_hybg_mat_mod, psb_protect_name => psb_z_cuda_hybg_to_gpu implicit none class(psb_z_cuda_hybg_sparse_mat), intent(inout) :: a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: nzrm integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize,nz integer(psb_ipk_) :: nzdi,i,j,k,nrz integer(psb_ipk_), allocatable :: irpdi(:),jadi(:) complex(psb_dpk_), allocatable :: valdi(:) info = 0 if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return m = a%get_nrows() n = a%get_ncols() nz = a%get_nzeros() if (c_associated(a%deviceMat%Mat)) then info = HYBGDeviceFree(a%deviceMat) end if if (a%is_unit()) then ! ! CUSPARSE has the habit of storing the diagonal and then ignoring, ! whereas we do not store it. Hence this adapter code. ! nzdi = nz + m if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nzdi) if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) ! We are explicitly adding the diagonal if (info == 0) info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with ! TRIANGULAR if needed. Weird, but works. if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) if (info == 0) then irpdi(1) = 1 if (a%is_triangle().and.a%is_upper()) then do i=1,m j = irpdi(i) jadi(j) = i valdi(j) = zone nrz = a%irp(i+1)-a%irp(i) jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) irpdi(i+1) = j + nrz + 1 ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) end do else do i=1,m j = irpdi(i) nrz = a%irp(i+1)-a%irp(i) jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) jadi(j+nrz) = i valdi(j+nrz) = zone irpdi(i+1) = j + nrz + 1 ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) end do end if end if if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) if ((info == 0) .and. a%is_triangle()) then info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) if ((info == 0).and.a%is_upper()) then info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) else info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) end if end if else if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nz) if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with ! TRIANGULAR if needed. Weird, but works. if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) if (info == 0) then if (a%is_unit()) then info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) else info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) end if end if if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) if ((info == 0) .and. a%is_triangle()) then info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) if ((info == 0).and.a%is_upper()) then info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) else info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) end if end if endif if ((info == 0) .and. a%is_triangle()) then info = HYBGDeviceHybsmAnalysis(a%deviceMat) end if if (info /= 0) then write(0,*) 'Error in HYBG_TO_GPU ',info end if end subroutine psb_z_cuda_hybg_to_gpu #endif