LCOV - code coverage report
Current view: top level - mpi - mpi_col_den.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 222 273 81.3 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.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_col_den
       8             :   !
       9             :   ! collect all data calculated in cdnval on different pe's on pe 0
      10             :   !
      11             :   ! for some data also spread them back onto all pe's (Jan. 2019  U.Alekseeva)
      12             :   !
      13             : CONTAINS
      14         608 :   SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,&
      15         608 :                          results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp,mcd,slab,orbcomp)
      16             : 
      17             : #include"cpp_double.h"
      18             :     USE m_types
      19             :     USE m_constants
      20             :     USE m_juDFT
      21             :     IMPLICIT NONE
      22             : 
      23             :     TYPE(t_results),INTENT(INOUT):: results
      24             :     TYPE(t_mpi),INTENT(IN)       :: mpi
      25             :     TYPE(t_oneD),INTENT(IN)      :: oneD
      26             :     TYPE(t_input),INTENT(IN)     :: input
      27             :     TYPE(t_vacuum),INTENT(IN)    :: vacuum
      28             :     TYPE(t_noco),INTENT(IN)      :: noco
      29             :     TYPE(t_stars),INTENT(IN)     :: stars
      30             :     TYPE(t_sphhar),INTENT(IN)    :: sphhar
      31             :     TYPE(t_atoms),INTENT(IN)     :: atoms
      32             :     TYPE(t_potden),INTENT(INOUT) :: den
      33             :     INCLUDE 'mpif.h'
      34             :     ! ..
      35             :     ! ..  Scalar Arguments ..
      36             :     INTEGER, INTENT (IN) :: jspin
      37             :     ! ..
      38             :     ! ..  Array Arguments ..
      39             :     COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
      40             :     TYPE (t_orb),               INTENT(INOUT) :: orb
      41             :     TYPE (t_denCoeffs),         INTENT(INOUT) :: denCoeffs
      42             :     TYPE (t_denCoeffsOffdiag),  INTENT(INOUT) :: denCoeffsOffdiag
      43             :     TYPE (t_regionCharges),     INTENT(INOUT) :: regCharges
      44             :     TYPE (t_dos),               INTENT(INOUT) :: dos
      45             :     TYPE (t_mcd),     OPTIONAL, INTENT(INOUT) :: mcd
      46             :     TYPE (t_slab),    OPTIONAL, INTENT(INOUT) :: slab
      47             :     TYPE (t_orbcomp), OPTIONAL, INTENT(INOUT) :: orbcomp
      48             :     ! ..
      49             :     ! ..  Local Scalars ..
      50             :     INTEGER :: n, i
      51             :     ! ..
      52             :     ! ..  Local Arrays ..
      53             :     INTEGER :: ierr(3)
      54             :     COMPLEX, ALLOCATABLE :: c_b(:)
      55         608 :     REAL,    ALLOCATABLE :: r_b(:)
      56         608 :     INTEGER, ALLOCATABLE :: i_b(:)
      57             :     ! ..
      58             :     ! ..  External Subroutines
      59             :     EXTERNAL CPP_BLAS_scopy,CPP_BLAS_ccopy,MPI_REDUCE
      60             : 
      61         608 :     CALL timestart("mpi_col_den")
      62             : 
      63             :     ! -> Collect den%pw(:,jspin)
      64         608 :     n = stars%ng3
      65         608 :     ALLOCATE(c_b(n))
      66         608 :     CALL MPI_REDUCE(den%pw(:,jspin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
      67         608 :     IF (mpi%irank.EQ.0) CALL CPP_BLAS_ccopy(n, c_b, 1, den%pw(:,jspin), 1)
      68         608 :     DEALLOCATE (c_b)
      69             : 
      70             :     ! -> Collect den%vacxy(:,:,:,jspin)
      71         608 :     IF (input%film) THEN
      72             :        !n = vacuum%nmzxyd*(oneD%odi%n2d-1)*2
      73          16 :        n=size(den%vacxy(:,:,:,jspin))
      74          16 :        ALLOCATE(c_b(n))
      75          16 :        CALL MPI_REDUCE(den%vacxy(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
      76          16 :        IF (mpi%irank.EQ.0) CALL CPP_BLAS_ccopy(n, c_b, 1, den%vacxy(:,:,:,jspin), 1)
      77          16 :        DEALLOCATE (c_b)
      78             : 
      79             :        ! -> Collect den%vacz(:,:,jspin)
      80             :        !n = vacuum%nmzd*2
      81          16 :        n=size(den%vacz(:,:,jspin))
      82          16 :        ALLOCATE(r_b(n))
      83          16 :        CALL MPI_REDUCE(den%vacz(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
      84          16 :        IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, den%vacz(:,:,jspin), 1)
      85          16 :        DEALLOCATE (r_b)
      86             :     ENDIF
      87             : 
      88             :     ! -> Collect uu(),ud() and dd()
      89         608 :     n = (atoms%lmaxd+1)*atoms%ntype
      90         608 :     ALLOCATE(r_b(n))
      91         608 :     CALL MPI_ALLREDUCE(denCoeffs%uu(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
      92         608 :     CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uu(0:,:,jspin), 1)
      93         608 :     CALL MPI_ALLREDUCE(denCoeffs%du(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
      94         608 :     CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%du(0:,:,jspin), 1)
      95         608 :     CALL MPI_ALLREDUCE(denCoeffs%dd(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
      96         608 :     CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dd(0:,:,jspin), 1)
      97         608 :     DEALLOCATE (r_b)
      98             : 
      99             :     !--> Collect uunmt,udnmt,dunmt,ddnmt
     100         608 :     n = (((atoms%lmaxd*(atoms%lmaxd+3))/2)+1)*sphhar%nlhd*atoms%ntype
     101         608 :     ALLOCATE(r_b(n))
     102         608 :     CALL MPI_ALLREDUCE(denCoeffs%uunmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     103         608 :     CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uunmt(0:,:,:,jspin), 1)
     104         608 :     CALL MPI_ALLREDUCE(denCoeffs%udnmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     105         608 :     CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%udnmt(0:,:,:,jspin), 1)
     106         608 :     CALL MPI_ALLREDUCE(denCoeffs%dunmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     107         608 :     CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dunmt(0:,:,:,jspin), 1)
     108         608 :     CALL MPI_ALLREDUCE(denCoeffs%ddnmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     109         608 :     CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ddnmt(0:,:,:,jspin), 1)
     110         608 :     DEALLOCATE (r_b)
     111             : 
     112             :     !--> ener & sqal
     113         608 :     n=4*atoms%ntype
     114         608 :     ALLOCATE(r_b(n))
     115         608 :     CALL MPI_ALLREDUCE(regCharges%ener(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     116         608 :     CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%ener(0:,:,jspin), 1)
     117         608 :     CALL MPI_ALLREDUCE(regCharges%sqal(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     118         608 :     CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%sqal(0:,:,jspin), 1)
     119         608 :     DEALLOCATE (r_b)
     120             : 
     121             :     !--> svac & pvac
     122         608 :     IF ( input%film ) THEN
     123          16 :        n=SIZE(regCharges%svac,1)
     124          16 :        ALLOCATE(r_b(n))
     125          16 :        CALL MPI_ALLREDUCE(regCharges%svac(:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     126          16 :        CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%svac(:,jspin), 1)
     127          16 :        CALL MPI_ALLREDUCE(regCharges%pvac(:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     128          16 :        CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%pvac(:,jspin), 1)
     129          16 :        DEALLOCATE (r_b)
     130             :     ENDIF
     131             : 
     132             :     !collect DOS stuff
     133         608 :     n = SIZE(dos%jsym,1)*SIZE(dos%jsym,2)
     134         608 :     ALLOCATE(i_b(n))
     135         608 :     CALL MPI_REDUCE(dos%jsym(:,:,jspin),i_b,n,MPI_INTEGER,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     136         608 :     IF (mpi%irank.EQ.0) THEN
     137        1382 :        DO i = 1, SIZE(dos%jsym,2)
     138        1382 :           dos%jsym(:,i,jspin) = i_b((i-1)*SIZE(dos%jsym,1)+1:i*SIZE(dos%jsym,1))
     139             :        END DO
     140             :     END IF
     141         608 :     DEALLOCATE (i_b)
     142             : 
     143         608 :     n = SIZE(dos%ksym,1)*SIZE(dos%ksym,2)
     144         608 :     ALLOCATE(i_b(n))
     145         608 :     CALL MPI_REDUCE(dos%ksym(:,:,jspin),i_b,n,MPI_INTEGER,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     146         608 :     IF (mpi%irank.EQ.0) THEN
     147        1382 :        DO i = 1, SIZE(dos%ksym,2)
     148        1382 :           dos%ksym(:,i,jspin) = i_b((i-1)*SIZE(dos%ksym,1)+1:i*SIZE(dos%ksym,1))
     149             :        END DO
     150             :     END IF
     151         608 :     DEALLOCATE (i_b)
     152             : 
     153         608 :     n = SIZE(dos%qis,1)*SIZE(dos%qis,2)
     154         608 :     ALLOCATE(r_b(n))
     155         608 :     CALL MPI_REDUCE(dos%qis(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     156         608 :     IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qis(:,:,jspin), 1)
     157         608 :     DEALLOCATE (r_b)
     158             : 
     159         608 :     n = SIZE(dos%qal,1)*SIZE(dos%qal,2)*SIZE(dos%qal,3)*SIZE(dos%qal,4)
     160         608 :     ALLOCATE(r_b(n))
     161         608 :     CALL MPI_REDUCE(dos%qal(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     162         608 :     IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qal(0:,:,:,:,jspin), 1)
     163         608 :     DEALLOCATE (r_b)
     164             : 
     165         608 :     n = SIZE(dos%qvac,1)*SIZE(dos%qvac,2)*SIZE(dos%qvac,3)
     166         608 :     ALLOCATE(r_b(n))
     167         608 :     CALL MPI_REDUCE(dos%qvac(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     168         608 :     IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qvac(:,:,:,jspin), 1)
     169         608 :     DEALLOCATE (r_b)
     170             : 
     171         608 :     n = SIZE(dos%qvlay,1)*SIZE(dos%qvlay,2)*SIZE(dos%qvlay,3)*SIZE(dos%qvlay,4)
     172         608 :     ALLOCATE(r_b(n))
     173         608 :     CALL MPI_REDUCE(dos%qvlay(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     174         608 :     IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qvlay(:,:,:,:,jspin), 1)
     175         608 :     DEALLOCATE (r_b)
     176             : 
     177         608 :     n = SIZE(dos%qstars,1)*SIZE(dos%qstars,2)*SIZE(dos%qstars,3)*SIZE(dos%qstars,4)*SIZE(dos%qstars,5)
     178         608 :     ALLOCATE(c_b(n))
     179         608 :     CALL MPI_REDUCE(dos%qstars(:,:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     180         608 :     IF (mpi%irank.EQ.0) CALL CPP_BLAS_ccopy(n, c_b, 1, dos%qstars(:,:,:,:,:,jspin), 1)
     181         608 :     DEALLOCATE (c_b)
     182             : 
     183             :     ! Collect mcd%mcd
     184         608 :     IF (PRESENT(mcd)) THEN
     185         608 :        n = SIZE(mcd%mcd,1)*SIZE(mcd%mcd,2)*SIZE(mcd%mcd,3)*SIZE(mcd%mcd,4)
     186         608 :        ALLOCATE(r_b(n))
     187         608 :        CALL MPI_REDUCE(mcd%mcd(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     188         608 :        IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, mcd%mcd(:,:,:,:,jspin), 1)
     189         608 :        DEALLOCATE (r_b)
     190             :     END IF
     191             : 
     192             :     ! Collect slab - qintsl and qmtsl
     193         608 :     IF (PRESENT(slab)) THEN
     194         608 :        n = SIZE(slab%qintsl,1)*SIZE(slab%qintsl,2)*SIZE(slab%qintsl,3)
     195         608 :        ALLOCATE(r_b(n))
     196         608 :        CALL MPI_REDUCE(slab%qintsl(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     197         608 :        IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, slab%qintsl(:,:,:,jspin), 1)
     198         608 :        DEALLOCATE (r_b)
     199             : 
     200         608 :        n = SIZE(slab%qmtsl,1)*SIZE(slab%qmtsl,2)*SIZE(slab%qmtsl,3)
     201         608 :        ALLOCATE(r_b(n))
     202         608 :        CALL MPI_REDUCE(slab%qmtsl(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     203         608 :        IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, slab%qmtsl(:,:,:,jspin), 1)
     204         608 :        DEALLOCATE (r_b)
     205             :     END IF
     206             : 
     207             :     ! Collect orbcomp - comp and qmtp
     208         608 :     IF (PRESENT(orbcomp)) THEN
     209         608 :        n = SIZE(orbcomp%comp,1)*SIZE(orbcomp%comp,2)*SIZE(orbcomp%comp,3)*SIZE(orbcomp%comp,4)
     210         608 :        ALLOCATE(r_b(n))
     211         608 :        CALL MPI_REDUCE(orbcomp%comp(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     212         608 :        IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, orbcomp%comp(:,:,:,:,jspin), 1)
     213         608 :        DEALLOCATE (r_b)
     214             : 
     215         608 :        n = SIZE(orbcomp%qmtp,1)*SIZE(orbcomp%qmtp,2)*SIZE(orbcomp%qmtp,3)
     216         608 :        ALLOCATE(r_b(n))
     217         608 :        CALL MPI_REDUCE(orbcomp%qmtp(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     218         608 :        IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, orbcomp%qmtp(:,:,:,jspin), 1)
     219         608 :        DEALLOCATE (r_b)
     220             :     END IF
     221             : 
     222             :     ! -> Collect force
     223         608 :     IF (input%l_f) THEN
     224           4 :        n=3*atoms%ntype
     225           4 :        ALLOCATE(r_b(n))
     226           4 :        CALL MPI_REDUCE(results%force(1,1,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     227           4 :        IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, results%force(1,1,jspin), 1)
     228           4 :        DEALLOCATE (r_b)
     229             :     ENDIF
     230             : 
     231             :     ! -> Optional the LO-coefficients: aclo,bclo,enerlo,cclo,acnmt,bcnmt,ccnmt
     232         608 :     IF (atoms%nlod.GE.1) THEN
     233             : 
     234         608 :        n=atoms%nlod*atoms%ntype 
     235         608 :        ALLOCATE (r_b(n))
     236         608 :        CALL MPI_ALLREDUCE(denCoeffs%aclo(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM, MPI_COMM_WORLD,ierr)
     237         608 :        CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%aclo(:,:,jspin), 1)
     238         608 :        CALL MPI_ALLREDUCE(denCoeffs%bclo(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM, MPI_COMM_WORLD,ierr)
     239         608 :        CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%bclo(:,:,jspin), 1)
     240         608 :        CALL MPI_ALLREDUCE(regCharges%enerlo(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     241         608 :        CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%enerlo(:,:,jspin), 1)
     242         608 :        CALL MPI_ALLREDUCE(regCharges%sqlo(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,MPI_COMM_WORLD,ierr)
     243         608 :        CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%sqlo(:,:,jspin), 1)
     244         608 :        DEALLOCATE (r_b)
     245             : 
     246         608 :        n = atoms%nlod * atoms%nlod * atoms%ntype
     247         608 :        ALLOCATE (r_b(n))
     248         608 :        CALL MPI_ALLREDUCE(denCoeffs%cclo(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM, MPI_COMM_WORLD,ierr)
     249         608 :        CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%cclo(:,:,:,jspin), 1)
     250         608 :        DEALLOCATE (r_b)
     251             : 
     252         608 :        n = (atoms%lmaxd+1) * atoms%ntype * atoms%nlod * sphhar%nlhd
     253         608 :        ALLOCATE (r_b(n))
     254         608 :        CALL MPI_ALLREDUCE(denCoeffs%acnmt(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM, MPI_COMM_WORLD,ierr)
     255         608 :        CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%acnmt(0:,:,:,:,jspin), 1)
     256         608 :        CALL MPI_ALLREDUCE(denCoeffs%bcnmt(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM, MPI_COMM_WORLD,ierr)
     257         608 :        CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%bcnmt(0:,:,:,:,jspin), 1)
     258         608 :        DEALLOCATE (r_b)
     259             : 
     260         608 :        n = atoms%ntype * sphhar%nlhd * atoms%nlod**2
     261         608 :        ALLOCATE (r_b(n))
     262         608 :        CALL MPI_ALLREDUCE(denCoeffs%ccnmt(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM, MPI_COMM_WORLD,ierr)
     263         608 :        CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ccnmt(:,:,:,:,jspin), 1)
     264         608 :        DEALLOCATE (r_b)
     265             : 
     266             :     ENDIF
     267             : 
     268             :     ! ->  Now the SOC - stuff: orb, orblo and orblo
     269         608 :     IF (noco%l_soc) THEN
     270             :        ! orb
     271         184 :        n=(atoms%lmaxd+1)*(2*atoms%lmaxd+1)*atoms%ntype
     272         184 :        ALLOCATE (r_b(n))
     273         184 :        CALL MPI_ALLREDUCE(orb%uu(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,MPI_COMM_WORLD,ierr)
     274         184 :        CALL CPP_BLAS_scopy(n, r_b, 1, orb%uu(:,:,:,jspin), 1)
     275         184 :        CALL MPI_ALLREDUCE(orb%dd(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,MPI_COMM_WORLD,ierr)
     276         184 :        CALL CPP_BLAS_scopy(n, r_b, 1, orb%dd(:,:,:,jspin), 1)
     277         184 :        DEALLOCATE (r_b)
     278             : 
     279         184 :        ALLOCATE (c_b(n))
     280         184 :        CALL MPI_ALLREDUCE(orb%uup(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     281         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uup(:,:,:,jspin), 1)
     282         184 :        CALL MPI_ALLREDUCE(orb%ddp(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     283         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%ddp(:,:,:,jspin), 1)
     284         184 :        CALL MPI_ALLREDUCE(orb%uum(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     285         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uum(:,:,:,jspin), 1)
     286         184 :        CALL MPI_ALLREDUCE(orb%ddm(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     287         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%ddm(:,:,:,jspin), 1)
     288         184 :        DEALLOCATE (c_b)
     289             : 
     290         184 :        n = atoms%nlod * (2*atoms%llod+1) * atoms%ntype
     291         184 :        ALLOCATE (r_b(n))
     292         184 :        CALL MPI_ALLREDUCE(orb%uulo(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,MPI_COMM_WORLD,ierr)
     293         184 :        CALL CPP_BLAS_scopy(n, r_b, 1, orb%uulo(:,:,:,jspin), 1)
     294         184 :        CALL MPI_ALLREDUCE(orb%dulo(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,MPI_COMM_WORLD,ierr)
     295         184 :        CALL CPP_BLAS_scopy(n, r_b, 1, orb%dulo(:,:,:,jspin), 1)
     296         184 :        DEALLOCATE (r_b)
     297             : 
     298         184 :        ALLOCATE (c_b(n))
     299         184 :        CALL MPI_ALLREDUCE(orb%uulop(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     300         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uulop(:,:,:,jspin), 1)
     301         184 :        CALL MPI_ALLREDUCE(orb%dulop(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     302         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%dulop(:,:,:,jspin), 1)
     303         184 :        CALL MPI_ALLREDUCE(orb%uulom(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     304         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uulom(:,:,:,jspin), 1)
     305         184 :        CALL MPI_ALLREDUCE(orb%dulom(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     306         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%dulom(:,:,:,jspin), 1)
     307         184 :        DEALLOCATE (c_b)
     308             : 
     309         184 :        n = atoms%nlod * atoms%nlod * (2*atoms%llod+1) * atoms%ntype
     310         184 :        ALLOCATE (r_b(n))
     311         184 :        CALL MPI_ALLREDUCE(orb%z(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,MPI_COMM_WORLD,ierr)
     312         184 :        CALL CPP_BLAS_scopy(n, r_b, 1, orb%z(:,:,:,:,jspin), 1)
     313         184 :        DEALLOCATE (r_b)
     314             : 
     315         184 :        ALLOCATE (c_b(n))
     316         184 :        CALL MPI_ALLREDUCE(orb%p(:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     317         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%p(:,:,:,:,jspin), 1)
     318         184 :        CALL MPI_ALLREDUCE(orb%m(:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     319         184 :        CALL CPP_BLAS_ccopy(n, c_b, 1, orb%m(:,:,:,:,jspin), 1)
     320         184 :        DEALLOCATE (c_b)
     321             : 
     322             :     ENDIF
     323             : 
     324             :     ! -> Collect the noco staff: 
     325         608 :     IF ( noco%l_noco .AND. jspin.EQ.1 ) THEN
     326             : 
     327         248 :        n = stars%ng3
     328         248 :        ALLOCATE(c_b(n))
     329         248 :        CALL MPI_REDUCE(den%pw(:,3),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     330         248 :        IF (mpi%irank.EQ.0) THEN
     331         124 :           den%pw(:,3)=RESHAPE(c_b,(/n/))
     332             :        ENDIF
     333         248 :        DEALLOCATE (c_b)
     334             :        !
     335         248 :        IF (input%film) THEN
     336             : 
     337             :           !n = vacuum%nmzxyd*(oneD%odi%n2d-1)*2
     338           0 :           n=size(den%vacxy(:,:,:,3))
     339           0 :           ALLOCATE(c_b(n))
     340           0 :           CALL MPI_REDUCE(den%vacxy(:,:,:,3),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     341           0 :           IF (mpi%irank.EQ.0) THEN
     342           0 :              CALL CPP_BLAS_ccopy(n, c_b, 1, den%vacxy(:,:,:,3), 1)
     343             :           ENDIF
     344           0 :           DEALLOCATE (c_b)
     345             :           !
     346             :           !n = vacuum%nmzd*2*2
     347           0 :           n=SIZE(den%vacz(:,:,3:4))
     348           0 :           ALLOCATE(r_b(n))
     349           0 :           CALL MPI_REDUCE(den%vacz(:,:,3:4),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     350           0 :           IF (mpi%irank.EQ.0) THEN
     351           0 :              den%vacz(:,:,3:4)=RESHAPE(r_b,SHAPE(den%vacz(:,:,3:4)))
     352             :           ENDIF
     353           0 :           DEALLOCATE (r_b)
     354             : 
     355             :        ENDIF ! input%film
     356             : 
     357             : 
     358         248 :        IF (noco%l_mperp) THEN
     359             : 
     360             :           ! -->     for (spin)-off diagonal part of muffin-tin
     361           0 :           n = (atoms%lmaxd+1) * atoms%ntype
     362           0 :           ALLOCATE(c_b(n))
     363           0 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%uu21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     364           0 :           CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uu21(:,:), 1)
     365           0 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%ud21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     366           0 :           CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ud21(:,:), 1)
     367           0 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%du21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     368           0 :           CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%du21(:,:), 1)
     369           0 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%dd21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     370           0 :           CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dd21(:,:), 1)
     371           0 :           DEALLOCATE (c_b)
     372             : 
     373             :           ! -->     lo,u coeff's:
     374           0 :           n = atoms%nlod * atoms%ntype
     375           0 :           ALLOCATE(c_b(n))
     376           0 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%uulo21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     377           0 :           CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uulo21(:,:), 1)
     378           0 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%ulou21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     379           0 :           CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ulou21(:,:), 1)
     380           0 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%dulo21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     381           0 :           CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dulo21(:,:), 1)
     382           0 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%ulod21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     383           0 :           CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ulod21(:,:), 1)
     384           0 :           DEALLOCATE (c_b)
     385             : 
     386             :           ! -->     lo,lo' coeff's:
     387           0 :           n = atoms%nlod*atoms%nlod*atoms%ntype
     388           0 :           ALLOCATE(c_b(n))
     389           0 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%uloulop21,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     390           0 :           CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uloulop21, 1)
     391           0 :           DEALLOCATE (c_b)
     392             : 
     393           0 :           IF (denCoeffsOffdiag%l_fmpl) THEN
     394             : 
     395             :              !-->        Full magnetization plots: Collect uunmt21, etc.
     396           0 :              n = (atoms%lmaxd+1)**2 *sphhar%nlhd*atoms%ntype
     397           0 :              ALLOCATE(c_b(n))
     398           0 :              CALL MPI_ALLREDUCE(denCoeffsOffdiag%uunmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     399           0 :              CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uunmt21, 1)
     400           0 :              CALL MPI_ALLREDUCE(denCoeffsOffdiag%udnmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     401           0 :              CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%udnmt21, 1)
     402           0 :              CALL MPI_ALLREDUCE(denCoeffsOffdiag%dunmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     403           0 :              CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dunmt21, 1)
     404           0 :              CALL MPI_ALLREDUCE(denCoeffsOffdiag%ddnmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     405           0 :              CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ddnmt21, 1)
     406           0 :              DEALLOCATE (c_b)
     407             : 
     408             :           ENDIF ! fmpl
     409             :        ENDIF  ! mperp
     410             :     ENDIF   ! noco
     411             : 
     412             :     !+lda+U
     413         608 :     IF ( atoms%n_u.GT.0 ) THEN
     414          30 :        n = 49*atoms%n_u 
     415          30 :        ALLOCATE(c_b(n))
     416          30 :        CALL MPI_REDUCE(n_mmp,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     417          30 :        IF (mpi%irank.EQ.0) THEN
     418          15 :           CALL CPP_BLAS_ccopy(n, c_b, 1, n_mmp, 1)
     419             :        ENDIF
     420          30 :        DEALLOCATE (c_b)
     421             :     ENDIF
     422             :     !-lda+U
     423             : 
     424         608 :     CALL timestop("mpi_col_den")
     425             : 
     426         608 :   END SUBROUTINE mpi_col_den
     427             : END MODULE m_mpi_col_den

Generated by: LCOV version 1.13