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_reduce_potden
       8             : #ifdef CPP_MPI 
       9             :   use mpi 
      10             : #endif
      11             : CONTAINS
      12             : 
      13           0 :   SUBROUTINE mpi_reduce_potden( fmpi, stars, sphhar, atoms, input, vacuum,   noco, potden )
      14             : 
      15             :     ! It is assumed that, if some quantity is allocated for some fmpi rank, that it is also allocated on fmpi rank 0. 
      16             : 
      17             :     USE m_types
      18             :     USE m_constants
      19             :     USE m_juDFT
      20             :     IMPLICIT NONE
      21             : 
      22             :     TYPE(t_mpi),     INTENT(IN)     :: fmpi
      23             :      
      24             :     TYPE(t_input),   INTENT(IN)     :: input
      25             :     TYPE(t_vacuum),  INTENT(IN)     :: vacuum
      26             :     TYPE(t_noco),    INTENT(IN)     :: noco
      27             :     TYPE(t_stars),   INTENT(IN)     :: stars
      28             :     TYPE(t_sphhar),  INTENT(IN)     :: sphhar
      29             :     TYPE(t_atoms),   INTENT(IN)     :: atoms
      30             :     TYPE(t_potden),  INTENT(INOUT)  :: potden
      31             :     
      32             :     INTEGER              :: n
      33             :     INTEGER              :: ierr
      34           0 :     REAL,    ALLOCATABLE :: r_b(:)
      35             : 
      36             :     ! reduce pw
      37           0 :     n = stars%ng3 * size( potden%pw, 2 )
      38           0 :     allocate( r_b(n) )
      39           0 :     call MPI_REDUCE( potden%pw, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, fmpi%mpi_comm, ierr )
      40           0 :     if( fmpi%irank == 0 ) call zcopy( n, r_b, 1, potden%pw, 1 )
      41           0 :     deallocate( r_b )
      42             : 
      43             :     ! reduce mt
      44           0 :     n = atoms%jmtd * ( sphhar%nlhd + 1 ) * atoms%ntype * input%jspins
      45           0 :     allocate( r_b(n) )
      46           0 :     call MPI_REDUCE( potden%mt, r_b, n, MPI_DOUBLE_PRECISION, MPI_SUM, 0, fmpi%mpi_comm, ierr )
      47           0 :     if( fmpi%irank == 0 ) call dcopy( n, r_b, 1, potden%mt, 1 )
      48           0 :     deallocate( r_b )
      49             : 
      50             :     ! reduce pw_w
      51           0 :     if( allocated( potden%pw_w ) ) then
      52           0 :       n = stars%ng3 * size( potden%pw_w, 2 )
      53           0 :       allocate( r_b(n) )
      54           0 :       call MPI_REDUCE( potden%pw_w, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, fmpi%mpi_comm, ierr )
      55           0 :       if( fmpi%irank == 0 ) call zcopy( n, r_b, 1, potden%pw_w, 1 )
      56           0 :       deallocate( r_b )
      57             :     end if
      58             : 
      59             :     ! reduce vac
      60           0 :     if( allocated( potden%vac ) ) then
      61           0 :       n = vacuum%nmzd * stars%ng2 * 2 * size( potden%vac, 4 )
      62           0 :       allocate( r_b(n) )
      63           0 :       call MPI_REDUCE( potden%vac, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, fmpi%mpi_comm, ierr )
      64           0 :       if( fmpi%irank == 0 ) call zcopy( n, r_b, 1, potden%vac, 1 )
      65           0 :       deallocate( r_b )
      66             :     end if
      67             : 
      68             :     ! reduce mmpMat
      69           0 :     if( allocated( potden%mmpMat ) ) then
      70           0 :       n = size( potden%mmpMat, 1 ) * size( potden%mmpMat, 2 ) * size( potden%mmpMat, 3 ) * size( potden%mmpMat, 4 )
      71           0 :       allocate( r_b(n) )
      72           0 :       call MPI_REDUCE( potden%mmpMat, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, fmpi%mpi_comm, ierr )
      73           0 :       if( fmpi%irank == 0 ) call zcopy( n, r_b, 1, potden%mmpMat, 1 )
      74           0 :       deallocate( r_b )
      75             :     end if
      76             : 
      77           0 :   END SUBROUTINE mpi_reduce_potden
      78             : 
      79             : END MODULE m_mpi_reduce_potden