LCOV - code coverage report
Current view: top level - mpi - mpi_col_den.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 364 376 96.8 %
Date: 2024-03-29 04:21:46 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             : #ifdef CPP_MPI
      14             :    use mpi
      15             : #endif
      16             : CONTAINS
      17        1078 :   SUBROUTINE mpi_col_den(fmpi,sphhar,atoms ,stars,vacuum,input,noco,jspin,dos,vacdos,&
      18             :                          results,denCoeffs,orb,denCoeffsOffdiag,den,regCharges,mcd,slab,orbcomp,jDOS)
      19             : 
      20             :     USE m_types
      21             :     USE m_constants
      22             :     USE m_juDFT
      23             :     use m_types_mcd
      24             :     use m_types_slab
      25             :     use m_types_orbcomp
      26             :     use m_types_jDOS
      27             :     use m_types_vacdos
      28             :     IMPLICIT NONE
      29             : 
      30             :     TYPE(t_results),INTENT(INOUT):: results
      31             :     TYPE(t_mpi),INTENT(IN)       :: fmpi
      32             : 
      33             :     TYPE(t_input),INTENT(IN)     :: input
      34             :     TYPE(t_vacuum),INTENT(IN)    :: vacuum
      35             :     TYPE(t_noco),INTENT(IN)      :: noco
      36             :     TYPE(t_stars),INTENT(IN)     :: stars
      37             :     TYPE(t_sphhar),INTENT(IN)    :: sphhar
      38             :     TYPE(t_atoms),INTENT(IN)     :: atoms
      39             :     TYPE(t_potden),INTENT(INOUT) :: den
      40             :     ! ..
      41             :     ! ..  Scalar Arguments ..
      42             :     INTEGER, INTENT (IN) :: jspin
      43             :     ! ..
      44             :     ! ..  Array Arguments ..
      45             : 
      46             :     TYPE (t_orb),               INTENT(INOUT) :: orb
      47             :     TYPE (t_denCoeffs),         INTENT(INOUT) :: denCoeffs
      48             :     TYPE (t_denCoeffsOffdiag),  INTENT(INOUT) :: denCoeffsOffdiag
      49             :     TYPE (t_dos),               INTENT(INOUT) :: dos
      50             :     TYPE (t_vacdos),            INTENT(INOUT) :: vacdos
      51             :     TYPE (t_regionCharges), OPTIONAL, INTENT(INOUT) :: regCharges
      52             :     TYPE (t_mcd),     OPTIONAL, INTENT(INOUT) :: mcd
      53             :     TYPE (t_slab),    OPTIONAL, INTENT(INOUT) :: slab
      54             :     TYPE (t_orbcomp), OPTIONAL, INTENT(INOUT) :: orbcomp
      55             :     TYPE (t_jDOS),    OPTIONAL, INTENT(INOUT) :: jDOS
      56             :     ! ..
      57             :     ! ..  Local Scalars ..
      58             :     INTEGER :: n, i
      59             :     ! ..
      60             :     ! ..  Local Arrays ..
      61             :     INTEGER :: ierr
      62             :     COMPLEX, ALLOCATABLE :: c_b(:)
      63        1078 :     REAL,    ALLOCATABLE :: r_b(:)
      64        1078 :     INTEGER, ALLOCATABLE :: i_b(:)
      65             :     ! ..
      66             :     ! ..  External Subroutines
      67             : #ifdef CPP_MPI
      68        1078 :     CALL timestart("mpi_col_den")
      69             : 
      70             :     ! -> Collect den%pw(:,jspin)
      71        1078 :     n = stars%ng3
      72        3234 :     ALLOCATE(c_b(n))
      73        1078 :     CALL MPI_ALLREDUCE(den%pw(:,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
      74        1078 :     CALL zcopy(n, c_b, 1, den%pw(:,jspin), 1)
      75        1078 :     DEALLOCATE (c_b)
      76             : 
      77        1078 :     IF (input%film) THEN
      78             :        ! -> Collect den%vac(:,:,:,jspin)
      79         464 :        n=size(den%vac(:,:,:,jspin))
      80         348 :        ALLOCATE(c_b(n))
      81         116 :        CALL MPI_REDUCE(den%vac(:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
      82         116 :        IF (fmpi%irank.EQ.0) CALL zcopy(n, c_b, 1, den%vac(:,:,:,jspin), 1)
      83         116 :        DEALLOCATE (c_b)
      84             :     ENDIF
      85             : 
      86             :     ! -> Collect uu(),ud() and dd()
      87        1078 :     n = (atoms%lmaxd+1)*atoms%ntype
      88        3234 :     ALLOCATE(r_b(n))
      89        1078 :     CALL MPI_ALLREDUCE(denCoeffs%uu(0:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
      90        1078 :     CALL dcopy(n, r_b, 1, denCoeffs%uu(0:,:,jspin), 1)
      91        1078 :     CALL MPI_ALLREDUCE(denCoeffs%du(0:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
      92        1078 :     CALL dcopy(n, r_b, 1, denCoeffs%du(0:,:,jspin), 1)
      93        1078 :     CALL MPI_ALLREDUCE(denCoeffs%dd(0:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
      94        1078 :     CALL dcopy(n, r_b, 1, denCoeffs%dd(0:,:,jspin), 1)
      95        1078 :     DEALLOCATE (r_b)
      96             : 
      97             :     ! Refactored stuff
      98        1078 :     n = 4*(atoms%lmaxd+1)*atoms%ntype
      99        3234 :     ALLOCATE(c_b(n))
     100        1078 :     CALL MPI_ALLREDUCE(denCoeffs%mt_coeff(0:,:,0:1,0:1,jspin,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     101        1078 :     CALL zcopy(n, c_b, 1, denCoeffs%mt_coeff(0:,:,0:1,0:1,jspin,jspin), 1)
     102        1078 :     DEALLOCATE (c_b)
     103             : 
     104             :     !--> Collect uunmt,udnmt,dunmt,ddnmt
     105        1078 :     n = (((atoms%lmaxd*(atoms%lmaxd+3))/2)+1)*sphhar%nlhd*atoms%ntype
     106        3234 :     ALLOCATE(r_b(n))
     107        1078 :     CALL MPI_ALLREDUCE(denCoeffs%uunmt(0:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     108        1078 :     CALL dcopy(n, r_b, 1, denCoeffs%uunmt(0:,:,:,jspin), 1)
     109        1078 :     CALL MPI_ALLREDUCE(denCoeffs%udnmt(0:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     110        1078 :     CALL dcopy(n, r_b, 1, denCoeffs%udnmt(0:,:,:,jspin), 1)
     111        1078 :     CALL MPI_ALLREDUCE(denCoeffs%dunmt(0:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     112        1078 :     CALL dcopy(n, r_b, 1, denCoeffs%dunmt(0:,:,:,jspin), 1)
     113        1078 :     CALL MPI_ALLREDUCE(denCoeffs%ddnmt(0:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     114        1078 :     CALL dcopy(n, r_b, 1, denCoeffs%ddnmt(0:,:,:,jspin), 1)
     115        1078 :     DEALLOCATE (r_b)
     116             : 
     117             :     ! Refactored stuff
     118        1078 :     n = 4*((atoms%lmaxd+1)**2)*sphhar%nlhd*atoms%ntype
     119        3234 :     ALLOCATE(c_b(n))
     120        1078 :     CALL MPI_ALLREDUCE(denCoeffs%nmt_coeff(0:,:,:,0:1,0:1,jspin,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     121        1078 :     CALL zcopy(n, c_b, 1, denCoeffs%nmt_coeff(0:,:,:,0:1,0:1,jspin,jspin), 1)
     122        1078 :     DEALLOCATE (c_b)
     123             : 
     124        1078 :     IF (PRESENT(regCharges)) THEN
     125             :       !--> ener & sqal
     126        1078 :       n=4*atoms%ntype
     127        3234 :       ALLOCATE(r_b(n))
     128        1078 :       CALL MPI_ALLREDUCE(regCharges%ener(0:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     129        1078 :       CALL dcopy(n, r_b, 1, regCharges%ener(0:,:,jspin), 1)
     130        1078 :       CALL MPI_ALLREDUCE(regCharges%sqal(0:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     131        1078 :       CALL dcopy(n, r_b, 1, regCharges%sqal(0:,:,jspin), 1)
     132        1078 :       DEALLOCATE (r_b)
     133             : 
     134             :       !--> svac & pvac
     135        1078 :       IF ( input%film ) THEN
     136         116 :          n=SIZE(regCharges%svac,1)
     137         348 :          ALLOCATE(r_b(n))
     138         116 :          CALL MPI_ALLREDUCE(regCharges%svac(:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     139         116 :          CALL dcopy(n, r_b, 1, regCharges%svac(:,jspin), 1)
     140         116 :          CALL MPI_ALLREDUCE(regCharges%pvac(:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     141         116 :          CALL dcopy(n, r_b, 1, regCharges%pvac(:,jspin), 1)
     142         116 :          DEALLOCATE (r_b)
     143             :        END IF
     144             :     END IF
     145             : 
     146             :     !collect DOS stuff
     147        1078 :     n = SIZE(dos%jsym,1)*SIZE(dos%jsym,2)
     148        3234 :     ALLOCATE(i_b(n))
     149        1078 :     CALL MPI_REDUCE(dos%jsym(:,:,jspin),i_b,n,MPI_INTEGER,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     150        1078 :     IF (fmpi%irank.EQ.0) THEN
     151        5821 :        DO i = 1, SIZE(dos%jsym,2)
     152      202635 :           dos%jsym(:,i,jspin) = i_b((i-1)*SIZE(dos%jsym,1)+1:i*SIZE(dos%jsym,1))
     153             :        END DO
     154             :     END IF
     155        1078 :     DEALLOCATE (i_b)
     156             : 
     157        1078 :     n = SIZE(dos%qis,1)*SIZE(dos%qis,2)
     158        3234 :     ALLOCATE(r_b(n))
     159        1078 :     CALL MPI_REDUCE(dos%qis(:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     160        1078 :     IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, dos%qis(:,:,jspin), 1)
     161        1078 :     DEALLOCATE (r_b)
     162             : 
     163        1078 :     n = SIZE(dos%qTot,1)*SIZE(dos%qTot,2)
     164        3234 :     ALLOCATE(r_b(n))
     165        1078 :     CALL MPI_REDUCE(dos%qTot(:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     166        1078 :     IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, dos%qTot(:,:,jspin), 1)
     167        1078 :     DEALLOCATE (r_b)
     168             : 
     169        1078 :     n = SIZE(dos%qal,1)*SIZE(dos%qal,2)*SIZE(dos%qal,3)*SIZE(dos%qal,4)
     170        3234 :     ALLOCATE(r_b(n))
     171        1078 :     CALL MPI_REDUCE(dos%qal(0:,:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     172        1078 :     IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, dos%qal(0:,:,:,:,jspin), 1)
     173        1078 :     DEALLOCATE (r_b)
     174             : 
     175        1078 :     n = SIZE(vacdos%qvac,1)*SIZE(vacdos%qvac,2)*SIZE(vacdos%qvac,3)
     176        3234 :     ALLOCATE(r_b(n))
     177        1078 :     CALL MPI_REDUCE(vacdos%qvac(:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     178        1078 :     IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, vacdos%qvac(:,:,:,jspin), 1)
     179        1078 :     DEALLOCATE (r_b)
     180             : 
     181        1078 :     n = SIZE(vacdos%qvlay,1)*SIZE(vacdos%qvlay,2)*SIZE(vacdos%qvlay,3)*SIZE(vacdos%qvlay,4)
     182        3234 :     ALLOCATE(r_b(n))
     183        1078 :     CALL MPI_REDUCE(vacdos%qvlay(:,:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     184        1078 :     IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, vacdos%qvlay(:,:,:,:,jspin), 1)
     185        1078 :     DEALLOCATE (r_b)
     186             : 
     187        1078 :     n = SIZE(vacdos%qstars,1)*SIZE(vacdos%qstars,2)*SIZE(vacdos%qstars,3)*SIZE(vacdos%qstars,4)*SIZE(vacdos%qstars,5)
     188        3234 :     ALLOCATE(c_b(n))
     189        1078 :     CALL MPI_REDUCE(vacdos%qstars(:,:,:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     190        1078 :     IF (fmpi%irank.EQ.0) CALL zcopy(n, c_b, 1, vacdos%qstars(:,:,:,:,:,jspin), 1)
     191        1078 :     DEALLOCATE (c_b)
     192             : 
     193             :     ! Collect mcd%mcd
     194        1078 :     IF (PRESENT(mcd)) THEN
     195        1078 :        n = SIZE(mcd%mcd,1)*SIZE(mcd%mcd,2)*SIZE(mcd%mcd,3)*SIZE(mcd%mcd,4)
     196        3234 :        ALLOCATE(r_b(n))
     197        1078 :        CALL MPI_REDUCE(mcd%mcd(:,:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     198        1078 :        IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, mcd%mcd(:,:,:,:,jspin), 1)
     199        1078 :        DEALLOCATE (r_b)
     200             :     END IF
     201             : 
     202             :     ! Collect slab - qintsl and qmtsl
     203        1078 :     IF (PRESENT(slab)) THEN
     204        1078 :        n = SIZE(slab%qintsl,1)*SIZE(slab%qintsl,2)*SIZE(slab%qintsl,3)
     205        3234 :        ALLOCATE(r_b(n))
     206        1078 :        CALL MPI_REDUCE(slab%qintsl(:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     207        1078 :        IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, slab%qintsl(:,:,:,jspin), 1)
     208        1078 :        DEALLOCATE (r_b)
     209             : 
     210        1078 :        n = SIZE(slab%qmtsl,1)*SIZE(slab%qmtsl,2)*SIZE(slab%qmtsl,3)
     211        3234 :        ALLOCATE(r_b(n))
     212        1078 :        CALL MPI_REDUCE(slab%qmtsl(:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     213        1078 :        IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, slab%qmtsl(:,:,:,jspin), 1)
     214        1078 :        DEALLOCATE (r_b)
     215             :     END IF
     216             : 
     217             :     ! Collect orbcomp - comp and qmtp
     218        1078 :     IF (PRESENT(orbcomp)) THEN
     219        1078 :        n = SIZE(orbcomp%comp,1)*SIZE(orbcomp%comp,2)*SIZE(orbcomp%comp,3)*SIZE(orbcomp%comp,4)
     220        3234 :        ALLOCATE(r_b(n))
     221        1078 :        CALL MPI_REDUCE(orbcomp%comp(:,:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     222        1078 :        IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, orbcomp%comp(:,:,:,:,jspin), 1)
     223        1078 :        DEALLOCATE (r_b)
     224             : 
     225        1078 :        n = SIZE(orbcomp%qmtp,1)*SIZE(orbcomp%qmtp,2)*SIZE(orbcomp%qmtp,3)
     226        3234 :        ALLOCATE(r_b(n))
     227        1078 :        CALL MPI_REDUCE(orbcomp%qmtp(:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     228        1078 :        IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, orbcomp%qmtp(:,:,:,jspin), 1)
     229        1078 :        DEALLOCATE (r_b)
     230             :     END IF
     231             : 
     232             :     !+jDOS
     233        1078 :     IF(PRESENT(jDOS)) THEN
     234        1078 :       IF(jspin.EQ.1) THEN
     235             : 
     236        4092 :         n = SIZE(jDOS%comp)
     237        2046 :         ALLOCATE(r_b(n))
     238         682 :         CALL MPI_REDUCE(jDOS%comp,r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0,MPI_COMM_WORLD,ierr)
     239         682 :         IF(fmpi%irank.EQ.0) CALL dcopy(n,r_b,1,jDOS%comp,1)
     240         682 :         DEALLOCATE(r_b)
     241             : 
     242        2728 :         n = SIZE(jDOS%qmtp)
     243        2046 :         ALLOCATE(r_b(n))
     244         682 :         CALL MPI_REDUCE(jDOS%qmtp,r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0,MPI_COMM_WORLD,ierr)
     245         682 :         IF(fmpi%irank.EQ.0) CALL dcopy(n,r_b,1,jDOS%qmtp,1)
     246         682 :         DEALLOCATE(r_b)
     247             : 
     248        2728 :         n = SIZE(jDOS%occ)
     249        2046 :         ALLOCATE(r_b(n))
     250         682 :         CALL MPI_REDUCE(jDOS%occ,r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0,MPI_COMM_WORLD,ierr)
     251         682 :         IF(fmpi%irank.EQ.0) CALL dcopy(n,r_b,1,jDOS%occ,1)
     252         682 :         DEALLOCATE(r_b)
     253             : 
     254             :       ENDIF
     255             :     ENDIF
     256             :     !-jDOS
     257             : 
     258             :     ! -> Collect force
     259        1078 :     IF (input%l_f) THEN
     260          58 :        n=3*atoms%ntype
     261         174 :        ALLOCATE(r_b(n))
     262          58 :        CALL MPI_REDUCE(results%force(1,1,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     263          58 :        IF (fmpi%irank.EQ.0) CALL dcopy(n, r_b, 1, results%force(1,1,jspin), 1)
     264          58 :        DEALLOCATE (r_b)
     265             :     ENDIF
     266             : 
     267             :     ! -> Optional the LO-coefficients: aclo,bclo,enerlo,cclo,acnmt,bcnmt,ccnmt
     268        1078 :     IF (atoms%nlod.GE.1) THEN
     269             : 
     270         708 :        n=atoms%nlod*atoms%ntype
     271        2124 :        ALLOCATE (r_b(n))
     272         708 :        CALL MPI_ALLREDUCE(denCoeffs%aclo(:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
     273         708 :        CALL dcopy(n, r_b, 1, denCoeffs%aclo(:,:,jspin), 1)
     274         708 :        CALL MPI_ALLREDUCE(denCoeffs%bclo(:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
     275         708 :        CALL dcopy(n, r_b, 1, denCoeffs%bclo(:,:,jspin), 1)
     276         708 :        IF (PRESENT(regCharges)) THEN
     277         708 :          CALL MPI_ALLREDUCE(regCharges%enerlo(:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     278         708 :          CALL dcopy(n, r_b, 1, regCharges%enerlo(:,:,jspin), 1)
     279         708 :          CALL MPI_ALLREDUCE(regCharges%sqlo(:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr)
     280         708 :          CALL dcopy(n, r_b, 1, regCharges%sqlo(:,:,jspin), 1)
     281             :        END IF
     282         708 :        DEALLOCATE (r_b)
     283             : 
     284             :        ! Refactored stuff
     285         708 :        n=2*atoms%nlod*atoms%ntype
     286        2124 :        ALLOCATE (c_b(n))
     287         708 :        CALL MPI_ALLREDUCE(denCoeffs%mt_ulo_coeff(:,:,0:1,jspin,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     288         708 :        CALL zcopy(n, c_b, 1, denCoeffs%mt_ulo_coeff(:,:,0:1,jspin,jspin), 1)
     289         708 :        CALL MPI_ALLREDUCE(denCoeffs%mt_lou_coeff(:,:,0:1,jspin,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     290         708 :        CALL zcopy(n, c_b, 1, denCoeffs%mt_lou_coeff(:,:,0:1,jspin,jspin), 1)
     291         708 :        DEALLOCATE (c_b)
     292             : 
     293         708 :        n = atoms%nlod * atoms%nlod * atoms%ntype
     294        2124 :        ALLOCATE (r_b(n))
     295         708 :        CALL MPI_ALLREDUCE(denCoeffs%cclo(:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
     296         708 :        CALL dcopy(n, r_b, 1, denCoeffs%cclo(:,:,:,jspin), 1)
     297         708 :        DEALLOCATE (r_b)
     298             : 
     299             :        ! Refactored stuff
     300         708 :        n = atoms%nlod * atoms%nlod * atoms%ntype
     301        2124 :        ALLOCATE (c_b(n))
     302         708 :        CALL MPI_ALLREDUCE(denCoeffs%mt_lolo_coeff(:,:,:,jspin,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     303         708 :        CALL zcopy(n, c_b, 1, denCoeffs%mt_lolo_coeff(:,:,:,jspin,jspin), 1)
     304         708 :        DEALLOCATE (c_b)
     305             : 
     306         708 :        n = (atoms%lmaxd+1) * atoms%ntype * atoms%nlod * sphhar%nlhd
     307        2124 :        ALLOCATE (r_b(n))
     308         708 :        CALL MPI_ALLREDUCE(denCoeffs%acnmt(0:,:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
     309         708 :        CALL dcopy(n, r_b, 1, denCoeffs%acnmt(0:,:,:,:,jspin), 1)
     310         708 :        CALL MPI_ALLREDUCE(denCoeffs%bcnmt(0:,:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
     311         708 :        CALL dcopy(n, r_b, 1, denCoeffs%bcnmt(0:,:,:,:,jspin), 1)
     312         708 :        DEALLOCATE (r_b)
     313             : 
     314             :        ! Refactored stuff
     315         708 :        n=2*atoms%nlod*atoms%ntype*(atoms%lmaxd+1)*sphhar%nlhd
     316        2124 :        ALLOCATE (c_b(n))
     317         708 :        CALL MPI_ALLREDUCE(denCoeffs%nmt_ulo_coeff(0:,:,:,:,0:1,jspin,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     318         708 :        CALL zcopy(n, c_b, 1, denCoeffs%nmt_ulo_coeff(0:,:,:,:,0:1,jspin,jspin), 1)
     319         708 :        CALL MPI_ALLREDUCE(denCoeffs%nmt_lou_coeff(0:,:,:,:,0:1,jspin,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     320         708 :        CALL zcopy(n, c_b, 1, denCoeffs%nmt_lou_coeff(0:,:,:,:,0:1,jspin,jspin), 1)
     321         708 :        DEALLOCATE (c_b)
     322             : 
     323         708 :        n = atoms%ntype * sphhar%nlhd * atoms%nlod**2
     324        2124 :        ALLOCATE (r_b(n))
     325         708 :        CALL MPI_ALLREDUCE(denCoeffs%ccnmt(:,:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM, MPI_COMM_WORLD,ierr)
     326         708 :        CALL dcopy(n, r_b, 1, denCoeffs%ccnmt(:,:,:,:,jspin), 1)
     327         708 :        DEALLOCATE (r_b)
     328             : 
     329             :        ! Refactored stuff
     330         708 :        n = atoms%ntype * sphhar%nlhd * atoms%nlod**2
     331        2124 :        ALLOCATE (c_b(n))
     332         708 :        CALL MPI_ALLREDUCE(denCoeffs%nmt_lolo_coeff(:,:,:,:,jspin,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     333         708 :        CALL zcopy(n, c_b, 1, denCoeffs%nmt_lolo_coeff(:,:,:,:,jspin,jspin), 1)
     334         708 :        DEALLOCATE (c_b)
     335             : 
     336             :     ENDIF
     337             : 
     338             :     ! ->  Now the SOC - stuff: orb, orblo and orblo
     339        1078 :     IF (noco%l_soc) THEN
     340             :        ! orb
     341         230 :        n=(atoms%lmaxd+1)*(2*atoms%lmaxd+1)*atoms%ntype
     342         690 :        ALLOCATE (r_b(n))
     343         230 :        CALL MPI_ALLREDUCE(orb%uu(:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION, MPI_SUM,MPI_COMM_WORLD,ierr)
     344         230 :        CALL dcopy(n, r_b, 1, orb%uu(:,:,:,jspin), 1)
     345         230 :        CALL MPI_ALLREDUCE(orb%dd(:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION, MPI_SUM,MPI_COMM_WORLD,ierr)
     346         230 :        CALL dcopy(n, r_b, 1, orb%dd(:,:,:,jspin), 1)
     347         230 :        DEALLOCATE (r_b)
     348             : 
     349         690 :        ALLOCATE (c_b(n))
     350         230 :        CALL MPI_ALLREDUCE(orb%uup(:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     351         230 :        CALL zcopy(n, c_b, 1, orb%uup(:,:,:,jspin), 1)
     352         230 :        CALL MPI_ALLREDUCE(orb%ddp(:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     353         230 :        CALL zcopy(n, c_b, 1, orb%ddp(:,:,:,jspin), 1)
     354         230 :        CALL MPI_ALLREDUCE(orb%uum(:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     355         230 :        CALL zcopy(n, c_b, 1, orb%uum(:,:,:,jspin), 1)
     356         230 :        CALL MPI_ALLREDUCE(orb%ddm(:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     357         230 :        CALL zcopy(n, c_b, 1, orb%ddm(:,:,:,jspin), 1)
     358         230 :        DEALLOCATE (c_b)
     359             : 
     360         230 :        n = atoms%nlod * (2*atoms%llod+1) * atoms%ntype
     361         690 :        ALLOCATE (r_b(n))
     362         230 :        CALL MPI_ALLREDUCE(orb%uulo(:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION, MPI_SUM,MPI_COMM_WORLD,ierr)
     363         230 :        CALL dcopy(n, r_b, 1, orb%uulo(:,:,:,jspin), 1)
     364         230 :        CALL MPI_ALLREDUCE(orb%dulo(:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION, MPI_SUM,MPI_COMM_WORLD,ierr)
     365         230 :        CALL dcopy(n, r_b, 1, orb%dulo(:,:,:,jspin), 1)
     366         230 :        DEALLOCATE (r_b)
     367             : 
     368         690 :        ALLOCATE (c_b(n))
     369         230 :        CALL MPI_ALLREDUCE(orb%uulop(:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     370         230 :        CALL zcopy(n, c_b, 1, orb%uulop(:,:,:,jspin), 1)
     371         230 :        CALL MPI_ALLREDUCE(orb%dulop(:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     372         230 :        CALL zcopy(n, c_b, 1, orb%dulop(:,:,:,jspin), 1)
     373         230 :        CALL MPI_ALLREDUCE(orb%uulom(:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     374         230 :        CALL zcopy(n, c_b, 1, orb%uulom(:,:,:,jspin), 1)
     375         230 :        CALL MPI_ALLREDUCE(orb%dulom(:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     376         230 :        CALL zcopy(n, c_b, 1, orb%dulom(:,:,:,jspin), 1)
     377         230 :        DEALLOCATE (c_b)
     378             : 
     379         230 :        n = atoms%nlod * atoms%nlod * (2*atoms%llod+1) * atoms%ntype
     380         690 :        ALLOCATE (r_b(n))
     381         230 :        CALL MPI_ALLREDUCE(orb%z(:,:,:,:,jspin),r_b,n,MPI_DOUBLE_PRECISION, MPI_SUM,MPI_COMM_WORLD,ierr)
     382         230 :        CALL dcopy(n, r_b, 1, orb%z(:,:,:,:,jspin), 1)
     383         230 :        DEALLOCATE (r_b)
     384             : 
     385         690 :        ALLOCATE (c_b(n))
     386         230 :        CALL MPI_ALLREDUCE(orb%p(:,:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     387         230 :        CALL zcopy(n, c_b, 1, orb%p(:,:,:,:,jspin), 1)
     388         230 :        CALL MPI_ALLREDUCE(orb%m(:,:,:,:,jspin),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     389         230 :        CALL zcopy(n, c_b, 1, orb%m(:,:,:,:,jspin), 1)
     390         230 :        DEALLOCATE (c_b)
     391             : 
     392             :     ENDIF
     393             : 
     394             :     ! -> Collect the noco stuff:
     395        1078 :     IF ( noco%l_noco .AND. jspin.EQ.1 ) THEN
     396             : 
     397         192 :        n = stars%ng3
     398         576 :        ALLOCATE(c_b(n))
     399         192 :        CALL MPI_REDUCE(den%pw(:,3),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     400         192 :        IF (fmpi%irank.EQ.0) THEN
     401      318974 :           den%pw(:,3)=RESHAPE(c_b,(/n/))
     402             :        ENDIF
     403         192 :        DEALLOCATE (c_b)
     404             :        !
     405         192 :        IF (input%film) THEN
     406           0 :           n=size(den%vac(:,:,:,3))
     407           0 :           ALLOCATE(c_b(n))
     408           0 :           CALL MPI_REDUCE(den%vac(:,:,:,3),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     409           0 :           IF (fmpi%irank.EQ.0) THEN
     410           0 :              CALL zcopy(n, c_b, 1, den%vac(:,:,:,3), 1)
     411             :           ENDIF
     412           0 :           DEALLOCATE (c_b)
     413             :        ENDIF ! input%film
     414             : 
     415             : 
     416         192 :        IF (noco%l_mperp) THEN
     417             : 
     418             :           ! -->     for (spin)-off diagonal part of muffin-tin
     419          58 :           n = (atoms%lmaxd+1) * atoms%ntype ! TODO: Why not from 0: in l-index?
     420         174 :           ALLOCATE(c_b(n))
     421          58 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%uu21(:,:),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     422          58 :           CALL zcopy(n, c_b, 1, denCoeffsOffdiag%uu21(:,:), 1)
     423          58 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%ud21(:,:),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     424          58 :           CALL zcopy(n, c_b, 1, denCoeffsOffdiag%ud21(:,:), 1)
     425          58 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%du21(:,:),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     426          58 :           CALL zcopy(n, c_b, 1, denCoeffsOffdiag%du21(:,:), 1)
     427          58 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%dd21(:,:),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     428          58 :           CALL zcopy(n, c_b, 1, denCoeffsOffdiag%dd21(:,:), 1)
     429          58 :           DEALLOCATE (c_b)
     430             : 
     431             :           ! Refactored stuff
     432          58 :           n = 4*(atoms%lmaxd+1)*atoms%ntype
     433         174 :           ALLOCATE(c_b(n))
     434          58 :           CALL MPI_ALLREDUCE(denCoeffs%mt_coeff(0:,:,0:1,0:1,2,1),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     435          58 :           CALL zcopy(n, c_b, 1, denCoeffs%mt_coeff(0:,:,0:1,0:1,2,1), 1)
     436          58 :           CALL MPI_ALLREDUCE(denCoeffs%mt_coeff(0:,:,0:1,0:1,1,2),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     437          58 :           CALL zcopy(n, c_b, 1, denCoeffs%mt_coeff(0:,:,0:1,0:1,1,2), 1)
     438          58 :           DEALLOCATE (c_b)
     439             : 
     440             :           ! -->     lo,u coeff's:
     441          58 :           n = atoms%nlod * atoms%ntype
     442         174 :           ALLOCATE(c_b(n))
     443          58 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%uulo21(:,:),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     444          58 :           CALL zcopy(n, c_b, 1, denCoeffsOffdiag%uulo21(:,:), 1)
     445          58 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%ulou21(:,:),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     446          58 :           CALL zcopy(n, c_b, 1, denCoeffsOffdiag%ulou21(:,:), 1)
     447          58 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%dulo21(:,:),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     448          58 :           CALL zcopy(n, c_b, 1, denCoeffsOffdiag%dulo21(:,:), 1)
     449          58 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%ulod21(:,:),c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     450          58 :           CALL zcopy(n, c_b, 1, denCoeffsOffdiag%ulod21(:,:), 1)
     451          58 :           DEALLOCATE (c_b)
     452             : 
     453             :           ! Refactored stuff
     454          58 :           n=2*atoms%nlod*atoms%ntype
     455         174 :           ALLOCATE (c_b(n))
     456          58 :           CALL MPI_ALLREDUCE(denCoeffs%mt_ulo_coeff(:,:,0:1,2,1),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     457          58 :           CALL zcopy(n, c_b, 1, denCoeffs%mt_ulo_coeff(:,:,0:1,2,1), 1)
     458          58 :           CALL MPI_ALLREDUCE(denCoeffs%mt_lou_coeff(:,:,0:1,2,1),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     459          58 :           CALL zcopy(n, c_b, 1, denCoeffs%mt_lou_coeff(:,:,0:1,2,1), 1)
     460          58 :           CALL MPI_ALLREDUCE(denCoeffs%mt_ulo_coeff(:,:,0:1,1,2),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     461          58 :           CALL zcopy(n, c_b, 1, denCoeffs%mt_ulo_coeff(:,:,0:1,1,2), 1)
     462          58 :           CALL MPI_ALLREDUCE(denCoeffs%mt_lou_coeff(:,:,0:1,1,2),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     463          58 :           CALL zcopy(n, c_b, 1, denCoeffs%mt_lou_coeff(:,:,0:1,1,2), 1)
     464          58 :           DEALLOCATE (c_b)
     465             : 
     466             :           ! -->     lo,lo' coeff's:
     467          58 :           n = atoms%nlod*atoms%nlod*atoms%ntype
     468         174 :           ALLOCATE(c_b(n))
     469          58 :           CALL MPI_ALLREDUCE(denCoeffsOffdiag%uloulop21,c_b,n,MPI_DOUBLE_COMPLEX, MPI_SUM,MPI_COMM_WORLD,ierr)
     470          58 :           CALL zcopy(n, c_b, 1, denCoeffsOffdiag%uloulop21, 1)
     471          58 :           DEALLOCATE (c_b)
     472             : 
     473             :           ! Refactored stuff
     474          58 :           n = atoms%nlod * atoms%nlod * atoms%ntype
     475         116 :           ALLOCATE (c_b(n))
     476          58 :           CALL MPI_ALLREDUCE(denCoeffs%mt_lolo_coeff(:,:,:,2,1),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     477          58 :           CALL zcopy(n, c_b, 1, denCoeffs%mt_lolo_coeff(:,:,:,2,1), 1)
     478          58 :           CALL MPI_ALLREDUCE(denCoeffs%mt_lolo_coeff(:,:,:,1,2),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     479          58 :           CALL zcopy(n, c_b, 1, denCoeffs%mt_lolo_coeff(:,:,:,1,2), 1)
     480          58 :           DEALLOCATE (c_b)
     481             : 
     482          58 :           IF (denCoeffsOffdiag%l_fmpl) THEN
     483             : 
     484             :              !-->        Full magnetization plots: Collect uunmt21, etc.
     485          58 :              n = (atoms%lmaxd+1)**2 *sphhar%nlhd*atoms%ntype
     486         174 :              ALLOCATE(c_b(n))
     487          58 :              CALL MPI_ALLREDUCE(denCoeffsOffdiag%uunmt21,c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     488          58 :              CALL zcopy(n, c_b, 1, denCoeffsOffdiag%uunmt21, 1)
     489          58 :              CALL MPI_ALLREDUCE(denCoeffsOffdiag%udnmt21,c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     490          58 :              CALL zcopy(n, c_b, 1, denCoeffsOffdiag%udnmt21, 1)
     491          58 :              CALL MPI_ALLREDUCE(denCoeffsOffdiag%dunmt21,c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     492          58 :              CALL zcopy(n, c_b, 1, denCoeffsOffdiag%dunmt21, 1)
     493          58 :              CALL MPI_ALLREDUCE(denCoeffsOffdiag%ddnmt21,c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     494          58 :              CALL zcopy(n, c_b, 1, denCoeffsOffdiag%ddnmt21, 1)
     495          58 :              DEALLOCATE (c_b)
     496             : 
     497             :              ! Refactored stuff
     498          58 :              n = 4*((atoms%lmaxd+1)**2)*sphhar%nlhd*atoms%ntype
     499         174 :              ALLOCATE(c_b(n))
     500          58 :              CALL MPI_ALLREDUCE(denCoeffs%nmt_coeff(0:,:,:,0:1,0:1,2,1),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     501          58 :              CALL zcopy(n, c_b, 1, denCoeffs%nmt_coeff(0:,:,:,0:1,0:1,2,1), 1)
     502          58 :              CALL MPI_ALLREDUCE(denCoeffs%nmt_coeff(0:,:,:,0:1,0:1,1,2),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,MPI_COMM_WORLD,ierr)
     503          58 :              CALL zcopy(n, c_b, 1, denCoeffs%nmt_coeff(0:,:,:,0:1,0:1,1,2), 1)
     504          58 :              DEALLOCATE (c_b)
     505             : 
     506             :              ! Refactored stuff
     507          58 :              n=2*atoms%nlod*atoms%ntype*(atoms%lmaxd+1)*sphhar%nlhd
     508         174 :              ALLOCATE (c_b(n))
     509          58 :              CALL MPI_ALLREDUCE(denCoeffs%nmt_ulo_coeff(0:,:,:,:,0:1,2,1),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     510          58 :              CALL zcopy(n, c_b, 1, denCoeffs%nmt_ulo_coeff(0:,:,:,:,0:1,2,1), 1)
     511          58 :              CALL MPI_ALLREDUCE(denCoeffs%nmt_lou_coeff(0:,:,:,:,0:1,2,1),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     512          58 :              CALL zcopy(n, c_b, 1, denCoeffs%nmt_lou_coeff(0:,:,:,:,0:1,2,1), 1)
     513          58 :              CALL MPI_ALLREDUCE(denCoeffs%nmt_ulo_coeff(0:,:,:,:,0:1,1,2),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     514          58 :              CALL zcopy(n, c_b, 1, denCoeffs%nmt_ulo_coeff(0:,:,:,:,0:1,1,2), 1)
     515          58 :              CALL MPI_ALLREDUCE(denCoeffs%nmt_lou_coeff(0:,:,:,:,0:1,1,2),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     516          58 :              CALL zcopy(n, c_b, 1, denCoeffs%nmt_lou_coeff(0:,:,:,:,0:1,1,2), 1)
     517          58 :              DEALLOCATE (c_b)
     518             : 
     519             :              ! Refactored stuff
     520          58 :              n = atoms%ntype * sphhar%nlhd * atoms%nlod**2
     521         174 :              ALLOCATE (c_b(n))
     522          58 :              CALL MPI_ALLREDUCE(denCoeffs%nmt_lolo_coeff(:,:,:,:,2,1),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     523          58 :              CALL zcopy(n, c_b, 1, denCoeffs%nmt_lolo_coeff(:,:,:,:,2,1), 1)
     524          58 :              CALL MPI_ALLREDUCE(denCoeffs%nmt_lolo_coeff(:,:,:,:,1,2),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM, MPI_COMM_WORLD,ierr)
     525          58 :              CALL zcopy(n, c_b, 1, denCoeffs%nmt_lolo_coeff(:,:,:,:,1,2), 1)
     526          58 :              DEALLOCATE (c_b)
     527             : 
     528             :           ENDIF ! fmpl
     529             :        ENDIF  ! mperp
     530             :     ENDIF   ! noco
     531             : 
     532             :     !+lda+U
     533        1078 :     IF ( atoms%n_u.GT.0 ) THEN
     534         100 :        n = 49*atoms%n_u
     535         300 :        ALLOCATE(c_b(n))
     536         100 :        CALL MPI_REDUCE(den%mmpMat(:,:,1:atoms%n_u,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     537         100 :        IF (fmpi%irank.EQ.0) THEN
     538          50 :           CALL zcopy(n, c_b, 1, den%mmpMat(:,:,1:atoms%n_u,jspin), 1)
     539             :        ENDIF
     540         100 :        DEALLOCATE (c_b)
     541         100 :        IF(noco%l_mperp.AND.jspin.EQ.1) THEN
     542           0 :          n = 49*atoms%n_u
     543           0 :          ALLOCATE(c_b(n))
     544           0 :          CALL MPI_REDUCE(den%mmpMat(:,:,1:atoms%n_u,3),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     545           0 :          IF (fmpi%irank.EQ.0) THEN
     546           0 :             CALL zcopy(n, c_b, 1, den%mmpMat(:,:,1:atoms%n_u,3), 1)
     547             :          ENDIF
     548           0 :          DEALLOCATE (c_b)
     549             :        ENDIF
     550             :     ENDIF
     551             :     !-lda+U
     552             : 
     553             :     !+lda+OP
     554        1078 :     IF ( atoms%n_opc.GT.0 ) THEN
     555          48 :       n = 49*atoms%n_opc
     556         144 :       ALLOCATE(c_b(n))
     557          48 :       CALL MPI_REDUCE(den%mmpMat(:,:,atoms%n_u+atoms%n_hia+1:,jspin),c_b,n,MPI_DOUBLE_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
     558          48 :       IF (fmpi%irank.EQ.0) THEN
     559          24 :          CALL zcopy(n, c_b, 1, den%mmpMat(:,:,atoms%n_u+atoms%n_hia+1:,jspin), 1)
     560             :       ENDIF
     561          48 :       DEALLOCATE (c_b)
     562             :    ENDIF
     563             :    !-lda+U
     564             : 
     565        1078 :     CALL timestop("mpi_col_den")
     566             : 
     567             : #endif
     568             : 
     569        1078 :   END SUBROUTINE mpi_col_den
     570             : END MODULE m_mpi_col_den

Generated by: LCOV version 1.14