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_mpi_bc_st
       8             : #ifdef CPP_MPI
       9             :   use mpi
      10             : #endif
      11             :   !**********************************************************************
      12             :   !     mpi_bc_st :  broadcast all information for qpw_to_nmt
      13             :   !     mpi_col_st:  collect the density from pe's 
      14             :   !**********************************************************************
      15             : CONTAINS
      16         636 :   SUBROUTINE mpi_bc_st(fmpi,stars,qpwc)
      17             :     !
      18             :     USE m_types
      19             :     IMPLICIT NONE
      20             : 
      21             :     TYPE(t_mpi),INTENT(IN)     :: fmpi
      22             :     TYPE(t_stars),INTENT(IN)   :: stars
      23             :     !     ..
      24             :     !     .. Array Arguments ..
      25             :     COMPLEX :: qpwc(stars%ng3)
      26             :     !     ..
      27             :     !     ..
      28             :     !     .. Local Arrays ..
      29             :     INTEGER ierr
      30             :     !
      31             :     ! -> Broadcast the arrays:
      32             : #ifdef CPP_MPI
      33         636 :     CALL MPI_BCAST(qpwc,stars%ng3,MPI_DOUBLE_COMPLEX,0,fmpi%mpi_comm,ierr)
      34             : #endif
      35             : 
      36         636 :   END SUBROUTINE mpi_bc_st
      37             :   !*********************************************************************
      38         636 :   SUBROUTINE mpi_col_st(fmpi,atoms,sphhar,rho)
      39             :     !
      40             :     USE m_types
      41             :     IMPLICIT NONE
      42             : 
      43             :     TYPE(t_mpi),INTENT(IN)     :: fmpi
      44             :     TYPE(t_sphhar),INTENT(IN)  :: sphhar
      45             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      46             :     !     ..
      47             :     !     .. Scalar Arguments ..
      48             :     REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype)
      49             : 
      50             :     INTEGER n
      51             :     INTEGER ierr
      52             :     REAL, ALLOCATABLE :: r_b(:)
      53             : #ifdef CPP_MPI
      54         636 :     n = atoms%jmtd*(sphhar%nlhd+1)*atoms%ntype
      55        1908 :     ALLOCATE(r_b(n))
      56             :     CALL MPI_REDUCE(rho,r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0,&
      57         636 :          &                                       fmpi%mpi_comm,ierr)
      58        1590 :     IF (fmpi%irank == 0) rho=reshape(r_b,(/atoms%jmtd,1+sphhar%nlhd,atoms%ntype/))
      59             : 
      60         636 :     DEALLOCATE(r_b) 
      61             : #endif
      62         636 :   END SUBROUTINE mpi_col_st
      63             :   !*********************************************************************
      64             : END MODULE m_mpi_bc_st