LCOV - code coverage report
Current view: top level - diagonalization - cusolver_diag.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 0 2 0.0 %
Date: 2024-03-28 04:22:06 Functions: 0 1 0.0 %

          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

Generated by: LCOV version 1.14