Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 : MODULE m_cusolver_diag
7 : USE m_types_mat
8 : USE m_types_mpimat
9 : USE m_judft
10 : #ifdef CPP_CUSOLVER
11 : use cusolverDn
12 : #endif
13 : IMPLICIT NONE
14 : PRIVATE
15 : #ifdef CPP_CUSOLVER
16 : type(cusolverDnHandle) :: handle
17 : #endif
18 : PUBLIC cusolver_diag
19 :
20 : CONTAINS
21 0 : SUBROUTINE cusolver_diag(hmat,smat,ne,eig,zmat)
22 : !!Simple driver to solve Generalized Eigenvalue Problem using CuSolverDN
23 : IMPLICIT NONE
24 : CLASS(t_mat),INTENT(INOUT) :: hmat,smat
25 : INTEGER,INTENT(INOUT) :: ne
26 : CLASS(t_mat),ALLOCATABLE,INTENT(OUT) :: zmat
27 : REAL,INTENT(OUT) :: eig(:)
28 :
29 : #ifdef CPP_CUSOLVER
30 : INTEGER :: istat,ne_found,lwork_d,devinfo(1)
31 : real,allocatable :: work_d(:),eig_tmp(:)
32 : complex,allocatable :: work_c(:)
33 :
34 : logical :: firstcall=.true.
35 : if (firstcall) THEN
36 : firstcall=.false.
37 : istat=cusolverDnCreate(handle)
38 : if (istat /= CUSOLVER_STATUS_SUCCESS) call judft_error('handle creation failed')
39 : endif
40 :
41 : ALLOCATE(t_mat::zmat)
42 : ALLOCATE(eig_tmp(hmat%matsize1))
43 : CALL zmat%alloc(hmat%l_real,hmat%matsize1,ne)
44 : !!$acc Data copyin(hmat,smat)
45 : IF (hmat%l_real) THEN
46 : associate(h=>hmat%data_r,s=>smat%data_r)
47 : !$ACC DATA copyin(s)COPY(h)COPYOUT(eig_tmp)
48 : !$ACC HOST_DATA USE_DEVICE(s,h,eig_tmp)
49 : istat = cusolverDnDsygvdx_bufferSize(handle, CUSOLVER_EIG_TYPE_1, CUSOLVER_EIG_MODE_VECTOR, CUSOLVER_EIG_RANGE_I, CUBLAS_FILL_MODE_UPPER, hmat%matsize1, h, hmat%matsize1, &
50 : s, smat%matsize1, 0.0, 0.0, 1, ne, ne_found, eig_tmp, lwork_d)
51 : !$acc end host_data
52 : if (istat /= CUSOLVER_STATUS_SUCCESS) call judft_error('cusolverDnZhegvdx_buffersize failed')
53 : allocate(work_d(lwork_d))
54 : !$ACC DATA create(work_d,devinfo)
55 : !$ACC HOST_DATA USE_DEVICE(s,h,eig_tmp,work_d,devinfo)
56 : istat = cusolverDnDsygvdx(handle, CUSOLVER_EIG_TYPE_1, CUSOLVER_EIG_MODE_VECTOR, CUSOLVER_EIG_RANGE_I, CUBLAS_FILL_MODE_UPPER, hmat%matsize1, h, hmat%matsize1, &
57 : s, smat%matsize1, 0.0, 0.0, 1, ne, ne_found, eig_tmp, work_d,lwork_d,devinfo(1))
58 : !$ACC END HOST_DATA
59 : !$ACC END DATA
60 : !$ACC END DATA
61 : if (istat /= CUSOLVER_STATUS_SUCCESS) call judft_error('cusolverDnZhegvdx failed')
62 : ne=ne_found
63 : CALL zmat%alloc(hmat%l_real,hmat%matsize1,ne_found)
64 : zmat%data_r=h(:,:ne_found)
65 : eig=eig_tmp(:ne)
66 : end associate
67 : ELSE
68 : associate(h=>hmat%data_c,s=>smat%data_c)
69 : !$ACC DATA copyin(s) COPY(h) COPYOUT(eig_tmp)
70 : !$ACC HOST_DATA USE_DEVICE(s,h,eig_tmp)
71 : istat = cusolverDnZhegvdx_bufferSize(handle, CUSOLVER_EIG_TYPE_1, CUSOLVER_EIG_MODE_VECTOR, CUSOLVER_EIG_RANGE_I, CUBLAS_FILL_MODE_UPPER, hmat%matsize1, h, hmat%matsize1, &
72 : s, smat%matsize1, 0.0, 0.0, 1, ne, ne_found, eig_tmp, lwork_d)
73 : !$acc end host_data
74 : if (istat /= CUSOLVER_STATUS_SUCCESS) write(*,*) 'cusolverDnZhegvdx_buffersize failed'
75 : allocate(work_c(lwork_d))
76 : !$ACC DATA create(work_c,devinfo)
77 : !$ACC HOST_DATA USE_DEVICE(s,h,eig_tmp,work_c,devinfo)
78 : istat = cusolverDnZhegvdx(handle, CUSOLVER_EIG_TYPE_1, CUSOLVER_EIG_MODE_VECTOR, CUSOLVER_EIG_RANGE_I, CUBLAS_FILL_MODE_UPPER, hmat%matsize1, h, hmat%matsize1, &
79 : s, smat%matsize1, 0.0, 0.0, 1, ne, ne_found, eig_tmp, work_c,lwork_d,devinfo(1))
80 : !$ACC END HOST_DATA
81 : !$acc update self(devinfo)
82 : if (istat /= CUSOLVER_STATUS_SUCCESS) THEN
83 : write(*,*) devinfo
84 : call judft_error('cusolverDnZhegvdx failed')
85 : endif
86 : !$ACC END DATA
87 : !$ACC END DATA
88 : ne =ne_found
89 : CALL zmat%alloc(hmat%l_real,hmat%matsize1,ne_found)
90 : zmat%data_c=h(:,:ne_found)
91 : eig=eig_tmp(:ne)
92 :
93 : end associate
94 : END IF
95 : #endif
96 :
97 0 : END SUBROUTINE cusolver_diag
98 :
99 :
100 : END MODULE m_cusolver_diag
|