magma.F90 2.63 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8 9 10 11 12 13 14
MODULE m_magma
  use m_juDFT
  INTEGER,PARAMETER :: NGPU_CONST=1
  !**********************************************************
  !     Solve the generalized eigenvalue problem
  !     using the MAGMA library for multiple GPUs
  !**********************************************************
CONTAINS
15
  SUBROUTINE magma_diag(hmat,smat,ne,eig,zmat)
16
#ifdef CPP_MAGMA
17
    use magma
18
#endif    
19
    use m_types_mat
20 21 22
    IMPLICIT NONE

    ! ... Arguments ...
23 24 25 26
    TYPE(t_mat),INTENT(INOUT)  :: hmat,smat
    INTEGER,INTENT(INOUT)      :: ne
    CLASS(t_mat),ALLOCATABLE,INTENT(OUT)    :: zmat
    REAL,INTENT(OUT)           :: eig(:)
27
  
28
#ifdef CPP_MAGMA
29 30

    ! ... Local Variables ..
31 32 33
    INTEGER :: lwork,liwork,lrwork,err,mout(1)
    REAL    :: eigTemp(hmat%matsize1)
    LOGICAL :: initialized=.false.
34 35 36

    REAL,    ALLOCATABLE :: rwork(:)
    INTEGER, ALLOCATABLE :: iwork(:)
37
    COMPLEX, ALLOCATABLE :: work(:)
38
    
39 40

    IF (.NOT.initialized) THEN
41 42
       initialized=.TRUE.
       CALL magmaf_init()
43 44
    ENDIF

45 46
    IF (hmat%l_real) THEN
       CALL juDFT_error("REAL diagonalization not implemented in magma.F90")
47
    ELSE
48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
       !Query the workspace size 
       ALLOCATE(work(1),rwork(1),iwork(1))
       CALL magmaf_zhegvdx(1,'v','i','l',hmat%matsize1,hmat%data_c,SIZE(hmat%data_c,1),smat%data_c,SIZE(smat%data_c,1),&
            0.0,0.0,1,ne,mout,eigTemp,work,-1,rwork,-1,iwork,-1,err)
       IF (err/=0) CALL juDFT_error("Failed to query workspaces",calledby="magma.F90")
       lwork=work(1)
       lrwork=rwork(1)
       liwork=iwork(1)
       DEALLOCATE(work,rwork,iwork)
       ALLOCATE(work(lwork),rwork(lrwork),iwork(liwork))
       !Now the diagonalization
       CALL magmaf_zhegvdx(1,'v','i','l',hmat%matsize1,hmat%data_c,SIZE(hmat%data_c,1),smat%data_c,SIZE(smat%data_c,1),&
            0.0,0.0,1,ne,mout,eigTemp,work,lwork,rwork,lrwork,iwork,liwork,err)
       IF (err/=0) CALL juDFT_error("Magma failed to diagonalize Hamiltonian")
    ENDIF
    ALLOCATE(t_mat::zmat)
    CALL zmat%alloc(hmat%l_real,hmat%matsize1,ne)
65 66
    DO i = 1, ne
       eig(i) = eigTemp(i)
67 68 69 70 71
       IF (hmat%l_real) THEN
          zmat%data_r(:,i)=hmat%data_r(:nsize,i)
       ELSE
          zmat%data_c(:,i)=hmat%data_c(:nsize,i)
       ENDIF
72
    END DO
73
#endif
74 75 76
  END SUBROUTINE magma_diag
END MODULE m_magma