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             : 
       7             : MODULE m_magma
       8             :   use m_juDFT
       9             :   INTEGER,SAVE :: Magma_NumGPU=1
      10             :   !**********************************************************
      11             :   !     Solve the generalized eigenvalue problem
      12             :   !     using the MAGMA library for multiple GPUs
      13             :   !**********************************************************
      14             : CONTAINS
      15           0 :   SUBROUTINE magma_diag(hmat,smat,ne,eig,zmat)
      16             : #ifdef CPP_MAGMA
      17             :     use magma
      18             :     use openacc
      19             : #endif
      20             :     use m_types
      21             :     IMPLICIT NONE
      22             : 
      23             :     ! ... Arguments ...
      24             :     TYPE(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_MAGMA
      30             : 
      31             :     ! ... Local Variables ..
      32             :     INTEGER :: lwork,liwork,lrwork,error,mout(1),i
      33             :     REAL    :: eigTemp(hmat%matsize1)
      34             :     LOGICAL :: initialized=.false.
      35             : 
      36             : 
      37             :     REAL,    ALLOCATABLE :: rwork(:)
      38             :     INTEGER, ALLOCATABLE :: iwork(:)
      39             :     COMPLEX, ALLOCATABLE :: work(:)
      40             : 
      41             : 
      42             :     IF (.NOT.initialized) THEN
      43             :        initialized=.TRUE.
      44             :        CALL magmaf_init()
      45             :        call magmaf_setdevice(acc_get_device_num(acc_device_nvidia))
      46             :        print *,acc_get_device_num(acc_device_nvidia)
      47             :     ENDIF
      48             : 
      49             :     IF (hmat%l_real) THEN
      50             :        ALLOCATE(rwork(1),iwork(1))
      51             :        !CALL magmaf_dsygvdx_m(Magma_numGPU,1,'v','i','U',hmat%matsize1,hmat%data_r,SIZE(hmat%data_r,1),smat%data_r,&
      52             :        !                    SIZE(smat%data_r,1),0.0,0.0,1,ne,mout,eigTemp,rwork,-1,iwork,-1,error)
      53             :        CALL magmaf_dsygvdx(1,'v','i','U',hmat%matsize1,hmat%data_r,SIZE(hmat%data_r,1),smat%data_r,&
      54             :                            SIZE(smat%data_r,1),0.0,0.0,1,ne,mout,eigTemp,rwork,-1,iwork,-1,error)
      55             :        IF (error/=0) THEN
      56             :           WRITE(*,*) 'magmaf_dsygvdx error code: ', error
      57             :           CALL juDFT_error("Failed to query workspaces (1)",calledby="magma.F90")
      58             :        END IF
      59             :        print *,"Magma1"
      60             :        lrwork=rwork(1)
      61             :        liwork=iwork(1)
      62             :        DEALLOCATE(rwork,iwork)
      63             :        ALLOCATE(rwork(lrwork),iwork(liwork))
      64             : !       CALL magmaf_dsygvdx_m(Magma_numGPU,1,'v','i','U',hmat%matsize1,hmat%data_r,SIZE(hmat%data_r,1),smat%data_r,&
      65             : !                           SIZE(smat%data_r,1),0.0,0.0,1,ne,mout,eigTemp,rwork,lrwork,iwork,liwork,error)
      66             :        CALL magmaf_dsygvdx(1,'v','i','U',hmat%matsize1,hmat%data_r,SIZE(hmat%data_r,1),smat%data_r,&
      67             :                            SIZE(smat%data_r,1),0.0,0.0,1,ne,mout,eigTemp,rwork,lrwork,iwork,liwork,error)
      68             :        print *,"Magma2"
      69             :        IF (error/=0) THEN
      70             :           WRITE(*,*) 'magmaf_dsygvdx error code: ', error
      71             :           CALL juDFT_error("Magma failed to diagonalize Hamiltonian (1)",calledby="magma.F90")
      72             :        END IF
      73             :     ELSE
      74             :        !Query the workspace size
      75             :        ALLOCATE(work(1),rwork(1),iwork(1))
      76             :        !CALL magmaf_zhegvdx_2stage_m(NGPU_CONST,&
      77             :        !CALL magmaf_zhegvdx_m(Magma_numGPU,1,'v','i','U',hmat%matsize1,hmat%data_c,SIZE(hmat%data_c,1),smat%data_c,&
      78             :        !                    SIZE(smat%data_c,1),0.0,0.0,1,ne,mout,eigTemp,work,-1,rwork,-1,iwork,-1,error)
      79             :        CALL magmaf_zhegvdx(1,'v','i','U',hmat%matsize1,hmat%data_c,SIZE(hmat%data_c,1),smat%data_c,&
      80             :                            SIZE(smat%data_c,1),0.0,0.0,1,ne,mout,eigTemp,work,-1,rwork,-1,iwork,-1,error)
      81             :        IF (error/=0) THEN
      82             :           WRITE(*,*) 'magmaf_zhegvdx error code: ', error
      83             :           CALL juDFT_error("Failed to query workspaces (2)",calledby="magma.F90")
      84             :        END IF
      85             :        print *,"Magma1"
      86             :        
      87             :        lwork=work(1)
      88             :        lrwork=rwork(1)
      89             :        liwork=iwork(1)
      90             :        DEALLOCATE(work,rwork,iwork)
      91             :        ALLOCATE(work(lwork),rwork(lrwork),iwork(liwork))
      92             :        !Now the diagonalization
      93             :        !CALL magmaf_zhegvdx_2stage_m(NGPU_CONST,&
      94             :        !CALL magmaf_zhegvdx_m(Magma_numGPU,1,'v','i','U',hmat%matsize1,hmat%data_c,SIZE(hmat%data_c,1),smat%data_c,&
      95             :        !                    SIZE(smat%data_c,1),0.0,0.0,1,ne,mout,eigTemp,work,lwork,rwork,lrwork,iwork,liwork,error)
      96             :        CALL magmaf_zhegvdx(1,'v','i','U',hmat%matsize1,hmat%data_c,SIZE(hmat%data_c,1),smat%data_c,&
      97             :                            SIZE(smat%data_c,1),0.0,0.0,1,ne,mout,eigTemp,work,lwork,rwork,lrwork,iwork,liwork,error)
      98             :        
      99             :                            print *,"Magma2"
     100             :        
     101             :         IF (error/=0) THEN
     102             :           WRITE(*,*) 'magmaf_zhegvdx error code: ', error
     103             :           CALL juDFT_error("Magma failed to diagonalize Hamiltonian (2)",calledby="magma.F90")
     104             :        END IF
     105             :     ENDIF
     106             : 
     107             :     ALLOCATE(t_mat::zmat)
     108             :     CALL zmat%alloc(hmat%l_real,hmat%matsize1,ne)
     109             :     DO i = 1, ne
     110             :        eig(i) = eigTemp(i)
     111             :        IF (hmat%l_real) THEN
     112             :           zmat%data_r(:,i)=hmat%data_r(:,i)
     113             :        ELSE
     114             :           zmat%data_c(:,i)=hmat%data_c(:,i)
     115             :        ENDIF
     116             :     END DO
     117             : #endif
     118           0 :   END SUBROUTINE magma_diag
     119             : END MODULE m_magma