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_eigen_redist_matrix
       8             : CONTAINS
       9             :   !> Collect Hamiltonian or overlap matrix to final form
      10             :   !!
      11             :   !! In the collinear case, this routine just copies mat(1,1) into the final matrix.
      12             :   !! If the matrices are distributed, the copy includes a redistribution into the block-cylic form needed by
      13             :   !! the diagonalization.
      14             :   !! In the non-collinear case, the 2x2 array of matrices is combined into the final matrix. Again a redistribution will happen in the parallel case
      15             : 
      16             : 
      17       14684 :   SUBROUTINE eigen_redist_matrix(fmpi,lapw,atoms,mat,mat_final,mat_final_templ)
      18             :    USE m_types
      19             :    USE m_types_mpimat
      20             :    IMPLICIT NONE
      21             :    TYPE(t_mpi),INTENT(IN)    :: fmpi
      22             :     TYPE(t_lapw),INTENT(IN)   :: lapw
      23             :     TYPE(t_atoms),INTENT(IN)  :: atoms
      24             :     CLASS(t_mat),INTENT(INOUT):: mat(:,:)
      25             :     CLASS(t_mat),INTENT(INOUT):: mat_final
      26             :     CLASS(t_mat),INTENT(IN),OPTIONAL :: mat_final_templ
      27             : 
      28             :     INTEGER:: m
      29             : 
      30             :     !determine final matrix size and allocate the final matrix
      31       14684 :     m=lapw%nv(1)+atoms%nlotot
      32       44052 :     IF (SIZE(mat)>1) m=m+lapw%nv(2)+atoms%nlotot
      33       14684 :     IF (.NOT.PRESENT(mat_final_templ)) THEN
      34        7342 :        CALL mat_final%init(mat(1,1)%l_real,m,m,fmpi%diag_sub_comm,.TRUE.) !here the .true. creates a block-cyclic scalapack distribution
      35             :     ELSE
      36        7342 :        CALL mat_final%init(mat_final_templ)
      37             :     ENDIF
      38             :     !up-up component (or only component in collinear case)
      39       44052 :     IF (SIZE(mat)==1) THEN
      40       13292 :        CALL mat_final%move(mat(1,1))
      41       13292 :        CALL mat(1,1)%free()
      42       13292 :        RETURN
      43             :     ENDIF
      44             : 
      45        1392 :     CALL mat_final%copy(mat(1,1),1,1)
      46        1392 :     CALL mat(1,1)%free()
      47             : 
      48             :     !down-down component
      49        1392 :     CALL mat_final%copy(mat(2,2),lapw%nv(1)+atoms%nlotot+1,lapw%nv(1)+atoms%nlotot+1)
      50        1392 :     CALL mat(2,2)%free()
      51             : 
      52        1392 :     if (lapw%nv(1).ne.lapw%nv(2).and.atoms%nlotot>0) call priv_copy_lapwLO_part(mat(2,1),mat(1,2),lapw%nv,atoms%nlotot,fmpi)
      53             : 
      54             : 
      55             :     !Now collect off-diagonal parts
      56        1392 :     IF (fmpi%n_size == 1 ) THEN
      57         176 :        CALL mat(1,2)%add_transpose(mat(2,1))
      58             :     ELSE
      59        1216 :        CALL mingeselle(mat(2,1),mat(1,2))
      60             :     ENDIF
      61        1392 :     CALL mat_final%copy(mat(1,2),1,lapw%nv(1)+atoms%nlotot+1)
      62        1392 :     CALL mat(1,2)%free()
      63        1392 :     CALL mat(2,1)%free()
      64             : 
      65             :   END SUBROUTINE eigen_redist_matrix
      66             : 
      67           0 :   subroutine priv_copy_lapwLO_Part(m1,m2,nv,nlotot,fmpi)
      68             :    USE m_types
      69             :    USE m_types_mpimat
      70             : #ifdef CPP_MPI
      71             :    use mpi 
      72             : #endif   
      73             :    implicit none
      74             :    CLASS(t_mat),target,INTENT(INOUT):: m1,m2
      75             :    integer,intent(in)               :: nv(2),nlotot
      76             :    TYPE(t_mpi),INTENT(IN)           :: fmpi
      77             :    
      78             :    integer                          :: blocksize,nstart,nstop,noff,i,ii,ierr
      79             :    class(t_mat),pointer             :: m_to,m_from
      80           0 :    COMPLEX,ALLOCATABLE              :: tmp(:,:)
      81             :    LOGICAL                          :: one2two
      82             : 
      83             : 
      84           0 :    if (m1%matsize1>m2%matsize1) THEN
      85           0 :       m_to=>m2
      86           0 :       m_from=>m1
      87             :    else
      88           0 :       m_to=>m1
      89           0 :       m_from=>m2
      90             :    endif   
      91             : 
      92             :   
      93             :    select type(m_from)
      94             :       type is(t_mat)   
      95           0 :       blocksize=abs(nv(1)-nv(2))
      96           0 :       nstart=m_from%matsize1-nlotot+1-blocksize
      97           0 :       nstop=m_from%matsize1-nlotot+1
      98           0 :       noff=m_from%matsize2-nlotot+1
      99             :       ! Do a simple copy
     100           0 :          m_to%data_c(noff:,nstart:nstop)=transpose(conjg(m_from%data_c(nstart:nstop,noff:)))
     101             :       type is(t_mpimat)
     102             : #ifdef CPP_MPI       
     103           0 :          blocksize=abs(nv(1)-nv(2))
     104           0 :          nstart=m_from%global_size1-nlotot+1-blocksize
     105           0 :          nstop=m_from%global_size1-nlotot+1
     106           0 :          noff=m_from%global_size2-nlotot+1
     107             :   
     108             :          !In parallel case create a matrix containing the block of the matrix
     109           0 :          ALLOCATE(tmp(blocksize+1,nlotot))
     110           0 :          tmp=0
     111             :          !Fill it with all data locally available
     112           0 :          DO i=0,nlotot-1
     113           0 :             IF (mod(i+noff-1,fmpi%n_size)==fmpi%irank) THEN
     114           0 :                ii=(i+noff-1)/fmpi%n_size+1
     115           0 :                tmp(:,i+1)=m_from%data_c(nstart:nstop,ii)
     116             :             ENDIF   
     117             :          enddo
     118             :          !send around (+conjgTranspose)
     119           0 :          tmp=conjg(transpose(tmp))
     120           0 :          CALL mpi_allreduce(MPI_IN_PLACE,tmp,size(tmp),MPI_DOUBLE_COMPLEX,mpi_sum,fmpi%mpi_comm,ierr)
     121             :          !Select data relevant for local matrix
     122           0 :          DO i=nstart,nstop
     123           0 :             IF (mod(i-1,fmpi%n_size)==fmpi%irank) THEN
     124           0 :                ii=(i-1)/fmpi%n_size+1
     125           0 :                m_to%data_c(noff:,ii)=tmp(:,i-nstart+1)
     126             :             ENDIF
     127             :          ENDDO
     128             : #endif         
     129             :    END SELECT      
     130             : 
     131           0 :   end subroutine
     132           0 : END MODULE m_eigen_redist_matrix