Commit 09a1904a authored by Daniel Wortmann's avatar Daniel Wortmann

Updated MAGMA interface, not compiled/tested yet

parent 35970705
...@@ -12,7 +12,7 @@ MODULE m_magma ...@@ -12,7 +12,7 @@ MODULE m_magma
! using the MAGMA library for multiple GPUs ! using the MAGMA library for multiple GPUs
!********************************************************** !**********************************************************
CONTAINS CONTAINS
SUBROUTINE magma_diag(nsize,eig,ne,a_r,b_r,z_r,a_c,b_c,z_c) SUBROUTINE magma_diag(hmat,smat,ne,eig,zmat)
#ifdef CPP_MAGMA #ifdef CPP_MAGMA
use magma use magma
#endif #endif
...@@ -20,84 +20,56 @@ CONTAINS ...@@ -20,84 +20,56 @@ CONTAINS
IMPLICIT NONE IMPLICIT NONE
! ... Arguments ... ! ... Arguments ...
TYPE(t_mat),INTENT(INOUT) :: hmat,smat
INTEGER, INTENT (IN) :: nsize INTEGER,INTENT(INOUT) :: ne
CLASS(t_mat),ALLOCATABLE,INTENT(OUT) :: zmat
REAL, INTENT(OUT) :: eig(:) REAL,INTENT(OUT) :: eig(:)
INTEGER, INTENT(INOUT) :: ne
REAL, OPTIONAL,ALLOCATABLE, INTENT (INOUT) :: a_r(:),b_r(:)
REAL, OPTIONAL,ALLOCATABLE, INTENT (INOUT) :: z_r(:,:)
COMPLEX, OPTIONAL,ALLOCATABLE, INTENT (INOUT) :: a_c(:),b_c(:)
COMPLEX, OPTIONAL,ALLOCATABLE, INTENT (INOUT) :: z_c(:,:)
#ifdef CPP_MAGMA #ifdef CPP_MAGMA
! ... Local Variables .. ! ... Local Variables ..
INTEGER iind,ind1,ind2,info,lwork,liwork,lrwork,err,i,mout(1) INTEGER :: lwork,liwork,lrwork,err,mout(1)
REAL eigTemp(nsize) REAL :: eigTemp(hmat%matsize1)
LOGICAL:: initialized=.false. LOGICAL :: initialized=.false.
REAL, ALLOCATABLE :: rwork(:) REAL, ALLOCATABLE :: rwork(:)
INTEGER, ALLOCATABLE :: iwork(:) INTEGER, ALLOCATABLE :: iwork(:)
COMPLEX, ALLOCATABLE :: work(:)
REAL, ALLOCATABLE :: largea_r(:,:),largeb_r(:,:)
COMPLEX, ALLOCATABLE :: largea_c(:,:),largeb_c(:,:)
COMPLEX,ALLOCATABLE :: work(:)
LOGICAL :: l_real
l_real=present(a_r)
print *,"MAGMA start"
IF (.NOT.initialized) THEN IF (.NOT.initialized) THEN
initialized=.true. initialized=.TRUE.
call magmaf_init() CALL magmaf_init()
print *,"MAGMA init"
ENDIF ENDIF
!********************************** IF (hmat%l_real) THEN
!expand from packed to full storage CALL juDFT_error("REAL diagonalization not implemented in magma.F90")
!**********************************
!hamiltonian
if (l_real) THEN
call packed_to_full(nsize,a_r,largea_r)
call packed_to_full(nsize,b_r,largeb_r)
!deallocate(a_r,b_r)
ELSE ELSE
call packed_to_full(nsize,a_c,largea_c)
call packed_to_full(nsize,b_c,largeb_c)
!deallocate(a_c,b_c)
Endif
if (l_real) call juDFT_error("REAL diagonalization not implemented in magma.F90")
!Query the workspace size !Query the workspace size
allocate(work(1),rwork(1),iwork(1)) ALLOCATE(work(1),rwork(1),iwork(1))
print *,"Magma workspace query" 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),&
call flush()
call magmaf_zhegvdx(1,'v','i','l',nsize,largea_c,nsize,largeb_c,nsize,&
0.0,0.0,1,ne,mout,eigTemp,work,-1,rwork,-1,iwork,-1,err) 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) lwork=work(1)
lrwork=rwork(1) lrwork=rwork(1)
liwork=iwork(1) liwork=iwork(1)
print*,"MAGMA:",lwork,lrwork,liwork DEALLOCATE(work,rwork,iwork)
deallocate(work,rwork,iwork) ALLOCATE(work(lwork),rwork(lrwork),iwork(liwork))
allocate(work(lwork),rwork(lrwork),iwork(liwork))
if (err/=0) call juDFT_error("Failed to allocate workspaces",calledby="magma.F90")
!Now the diagonalization !Now the diagonalization
print *,"Magma 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),&
print *,nsize,shape(largea_c),shape(eigTemp),ne
call magmaf_zhegvdx(1,'v','i','l',nsize,largea_c,nsize,largeb_c,nsize,&
0.0,0.0,1,ne,mout,eigTemp,work,lwork,rwork,lrwork,iwork,liwork,err) 0.0,0.0,1,ne,mout,eigTemp,work,lwork,rwork,lrwork,iwork,liwork,err)
print*,"MAGMA info:",err IF (err/=0) CALL juDFT_error("Magma failed to diagonalize Hamiltonian")
if (err/=0) call juDFT_error("Magma failed to diagonalize Hamiltonian") ENDIF
print *,"MAGMA mout:",mout ALLOCATE(t_mat::zmat)
CALL zmat%alloc(hmat%l_real,hmat%matsize1,ne)
DO i = 1, ne DO i = 1, ne
eig(i) = eigTemp(i) eig(i) = eigTemp(i)
z_c(:nsize,i)=largea_c(:nsize,i) 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
END DO END DO
!call judft_error("Eigenvectors are not calculated in MAGMA")
#endif #endif
END SUBROUTINE magma_diag END SUBROUTINE magma_diag
END MODULE m_magma END MODULE m_magma
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment