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_dfpt_eigen_redist_matrix
       8             : CONTAINS
       9           0 :    SUBROUTINE dfpt_eigen_redist_matrix(fmpi,lapwq,lapw,atoms,mat,mat_final,mat_final_templ)
      10             :       !> Collect Hamiltonian or overlap matrix perturbation to final form
      11             :       !!
      12             :       !! In the collinear case, this routine just copies mat(1,1) into the final matrix.
      13             :       !! In the non-collinear case, the 2x2 array of matrices is combined into the final matrix.
      14             :       USE m_types
      15             :       USE m_types_mpimat
      16             : 
      17             :       IMPLICIT NONE
      18             : 
      19             :       TYPE(t_mpi),   INTENT(IN)    :: fmpi
      20             :       TYPE(t_lapw),  INTENT(IN)    :: lapwq, lapw
      21             :       TYPE(t_atoms), INTENT(IN)    :: atoms
      22             :       CLASS(t_mat),  INTENT(INOUT) :: mat(:,:)
      23             :       CLASS(t_mat),  INTENT(INOUT) :: mat_final
      24             : 
      25             :       CLASS(t_mat),  INTENT(IN), OPTIONAL :: mat_final_templ
      26             : 
      27             :       INTEGER :: mPr, m
      28             : 
      29             :       !  Determine final matrix size and allocate the final matrix
      30           0 :       m = lapw%nv(1) + atoms%nlotot
      31           0 :       IF (SIZE(mat)>1)  m = m + lapw%nv(2) + atoms%nlotot
      32           0 :       mPr = lapwq%nv(1) + atoms%nlotot
      33           0 :       IF (SIZE(mat)>1)  mPr = mPr + lapwq%nv(2) + atoms%nlotot
      34             : 
      35           0 :       IF (.NOT.PRESENT(mat_final_templ)) THEN
      36           0 :          CALL mat_final%init(mat(1,1)%l_real,mPr,m,fmpi%diag_sub_comm,.TRUE.) !here the .true. creates a block-cyclic scalapack distribution
      37             :       ELSE
      38           0 :          CALL mat_final%init(mat_final_templ)
      39             :       END IF
      40             : 
      41             :       !Collinear case --> only component
      42           0 :       IF (SIZE(mat)==1) THEN
      43           0 :          CALL mat_final%move(mat(1,1))
      44           0 :          CALL mat(1,1)%free()
      45           0 :          RETURN
      46             :       END IF
      47             : 
      48             :       !up-up
      49           0 :       CALL mat_final%copy(mat(1,1),1,1)
      50           0 :       CALL mat(1,1)%free()
      51             : 
      52             :       !down-down component
      53           0 :       CALL mat_final%copy(mat(2,2),lapwq%nv(1)+atoms%nlotot+1,lapw%nv(1)+atoms%nlotot+1)
      54           0 :       CALL mat(2,2)%free()
      55             : 
      56             :       !Now collect the off-diagonal parts
      57             :       !down-up
      58           0 :       CALL mat_final%copy(mat(2,1),lapwq%nv(1)+atoms%nlotot+1,1)
      59           0 :       CALL mat(2,1)%free()
      60             : 
      61             :       !up-down
      62           0 :       CALL mat_final%copy(mat(1,2),1,lapw%nv(1)+atoms%nlotot+1)
      63           0 :       CALL mat(1,2)%free()
      64             : 
      65             :    END SUBROUTINE dfpt_eigen_redist_matrix
      66             : END MODULE m_dfpt_eigen_redist_matrix