Implementation of serial eigensolver with CU_BLAS, from C. Cavazzoni

This commit is contained in:
Pietro Bonfa 2020-04-22 13:15:41 +02:00
parent 5d6e57ac74
commit c735d989ef
1 changed files with 58 additions and 7 deletions

View File

@ -659,12 +659,16 @@ END SUBROUTINE laxlib_multi_init_desc_x
RETURN
END SUBROUTINE diagonalize_serial_x
#if (!defined(__USE_CUSOLVER)) && defined(__CUDA)
SUBROUTINE diagonalize_serial_gpu( m, rhos, rhod, s, info )
#if defined(__CUDA)
use cudafor
#if defined ( __USE_CUSOLVER )
USE cusolverDn
#else
use eigsolve_vars
use nvtx_inters
use dsyevd_gpu
use cudafor
#endif
IMPLICIT NONE
include 'laxlib_kinds.fh'
INTEGER, INTENT(IN) :: m
@ -673,15 +677,59 @@ END SUBROUTINE laxlib_multi_init_desc_x
REAL(DP), DEVICE, INTENT(OUT) :: s(:,:)
INTEGER, INTENT(OUT) :: info
!
REAL(DP), ALLOCATABLE :: work_d(:), a(:,:), b(:,:)
INTEGER :: lwork_d
INTEGER :: i, j, lda
!
#if defined (__USE_CUSOLVER)
!
INTEGER, DEVICE :: devInfo
TYPE(cusolverDnHandle) :: cuSolverHandle
REAL(DP), ALLOCATABLE, DEVICE :: work_d(:)
!
#else
!
REAL(DP), ALLOCATABLE :: work_d(:), a(:,:)
ATTRIBUTES( DEVICE ) :: work_d, a
REAL(DP), ALLOCATABLE :: b(:,:)
REAL(DP), ALLOCATABLE :: work_h(:), w_h(:), z_h(:,:)
ATTRIBUTES( PINNED ) :: work_h, w_h, z_h
INTEGER, ALLOCATABLE :: iwork_h(:)
ATTRIBUTES( PINNED ) :: iwork_h
!
INTEGER :: lwork_d, lwork_h, liwork_h
INTEGER :: i,j,lda
INTEGER :: lwork_h, liwork_h
!
#endif
! .... Subroutine Body
!
#if defined (__USE_CUSOLVER)
!
s = rhos
lda = SIZE( rhos, 1 )
!
info = cusolverDnCreate(cuSolverHandle)
IF ( info /= CUSOLVER_STATUS_SUCCESS ) &
CALL errore( ' diagonalize_serial_gpu ', 'cusolverDnCreate', ABS( info ) )
info = cusolverDnDsyevd_bufferSize( &
cuSolverHandle, CUSOLVER_EIG_MODE_VECTOR, CUBLAS_FILL_MODE_UPPER, m, s, lda, rhod, lwork_d)
IF( info /= 0 ) CALL lax_error__( ' laxlib diagonalize_serial_gpu ', ' error in solver 1 ', ABS( info ) )
ALLOCATE( work_d ( lwork_d ), STAT=info )
IF( info /= 0 ) CALL lax_error__( ' laxlib diagonalize_serial_gpu ', ' allocate work_d ', ABS( info ) )
info = cusolverDnDsyevd( &
cuSolverHandle, CUSOLVER_EIG_MODE_VECTOR, CUBLAS_FILL_MODE_UPPER, m, s, lda, rhod, work_d, lwork_d, devInfo)
IF( info /= 0 ) CALL lax_error__( ' laxlib diagonalize_serial_gpu ', ' error in solver 2 ', ABS( info ) )
info = cudaDeviceSynchronize()
info = cusolverDnDestroy(cuSolverHandle)
IF( info /= 0 ) CALL errore( ' diagonalize_serial_gpu ', ' cusolverDnDestroy failed ', ABS( info ) )
DEALLOCATE( work_d )
!
#else
!
info = 0
lwork_d = 2*64*64 + 66*SIZE(rhos,1)
@ -723,6 +771,9 @@ END SUBROUTINE laxlib_multi_init_desc_x
DEALLOCATE(work_h)
DEALLOCATE(a)
DEALLOCATE(work_d)
END SUBROUTINE
#endif
#else
CALL lax_error__( ' laxlib diagonalize_serial_gpu ', ' not compiled in this version ', 0 )
#endif
END SUBROUTINE