LCOV - code coverage report
Current view: top level - mpi - mpi_reduce_potden.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 37 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

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

Generated by: LCOV version 1.13