mpi_col_den.F90 18.6 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8 9 10 11
MODULE m_mpi_col_den
  !
  ! collect all data calculated in cdnval on different pe's on pe 0
  !
CONTAINS
12
  SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,&
13
                         results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp)
14

15 16
#include"cpp_double.h"
    USE m_types
Gregor Michalicek's avatar
Gregor Michalicek committed
17
    USE m_constants
18
    USE m_juDFT
19 20
    IMPLICIT NONE

21 22 23 24 25 26 27 28 29
    TYPE(t_results),INTENT(INOUT):: results
    TYPE(t_mpi),INTENT(IN)       :: mpi
    TYPE(t_oneD),INTENT(IN)      :: oneD 
    TYPE(t_input),INTENT(IN)     :: input 
    TYPE(t_vacuum),INTENT(IN)    :: vacuum 
    TYPE(t_noco),INTENT(IN)      :: noco 
    TYPE(t_stars),INTENT(IN)     :: stars 
    TYPE(t_sphhar),INTENT(IN)    :: sphhar 
    TYPE(t_atoms),INTENT(IN)     :: atoms
Gregor Michalicek's avatar
Gregor Michalicek committed
30
    TYPE(t_potden),INTENT(INOUT) :: den
31 32 33
    INCLUDE 'mpif.h'
    ! ..
    ! ..  Scalar Arguments ..
34
    INTEGER, INTENT (IN) :: jspin
35 36
    ! ..
    ! ..  Array Arguments ..
Gregor Michalicek's avatar
Gregor Michalicek committed
37
    COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
38 39 40
    TYPE (t_orb),              INTENT(INOUT) :: orb
    TYPE (t_denCoeffs),        INTENT(INOUT) :: denCoeffs
    TYPE (t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
41
    TYPE (t_regionCharges),    INTENT(INOUT) :: regCharges
42
    TYPE (t_dos),              INTENT(INOUT) :: dos
43 44 45 46 47 48 49 50
    ! ..
    ! ..  Local Scalars ..
    INTEGER :: n
    ! ..
    ! ..  Local Arrays ..
    INTEGER :: ierr(3)
    COMPLEX, ALLOCATABLE :: c_b(:)
    REAL,    ALLOCATABLE :: r_b(:)
51
    INTEGER, ALLOCATABLE :: i_b(:)
52 53 54 55
    ! ..
    ! ..  External Subroutines
    EXTERNAL CPP_BLAS_scopy,CPP_BLAS_ccopy,MPI_REDUCE

56
    CALL timestart("mpi_col_den")
57 58

    ! -> Collect den%pw(:,jspin)
59
    n = stars%ng3
60
    ALLOCATE(c_b(n))
61
    CALL MPI_REDUCE(den%pw(:,jspin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
62
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_ccopy(n, c_b, 1, den%pw(:,jspin), 1)
63
    DEALLOCATE (c_b)
64 65

    ! -> Collect den%vacxy(:,:,:,jspin)
66 67 68
    IF (input%film) THEN
       n = vacuum%nmzxyd*(oneD%odi%n2d-1)*2
       ALLOCATE(c_b(n))
69
       CALL MPI_REDUCE(den%vacxy(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
70
       IF (mpi%irank.EQ.0) CALL CPP_BLAS_ccopy(n, c_b, 1, den%vacxy(:,:,:,jspin), 1)
71
       DEALLOCATE (c_b)
72 73

       ! -> Collect den%vacz(:,:,jspin)
74 75
       n = vacuum%nmzd*2
       ALLOCATE(r_b(n))
76
       CALL MPI_REDUCE(den%vacz(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
77
       IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, den%vacz(:,:,jspin), 1)
78 79
       DEALLOCATE (r_b)
    ENDIF
80

81
    ! -> Collect uu(),ud() and dd()
Daniel Wortmann's avatar
Daniel Wortmann committed
82
    n = (atoms%lmaxd+1)*atoms%ntype
83
    ALLOCATE(r_b(n))
84
    CALL MPI_REDUCE(denCoeffs%uu(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
85
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uu(0:,:,jspin), 1)
86
    CALL MPI_REDUCE(denCoeffs%du(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
87
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%du(0:,:,jspin), 1)
88
    CALL MPI_REDUCE(denCoeffs%dd(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
89
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dd(0:,:,jspin), 1)
90
    DEALLOCATE (r_b)
91

92
    !--> Collect uunmt,udnmt,dunmt,ddnmt
93
    n = (((atoms%lmaxd*(atoms%lmaxd+3))/2)+1)*sphhar%nlhd*atoms%ntype
94
    ALLOCATE(r_b(n))
95
    CALL MPI_REDUCE(denCoeffs%uunmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
96
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uunmt(0:,:,:,jspin), 1)
97
    CALL MPI_REDUCE(denCoeffs%udnmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
98
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%udnmt(0:,:,:,jspin), 1)
99
    CALL MPI_REDUCE(denCoeffs%dunmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
100
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dunmt(0:,:,:,jspin), 1)
101
    CALL MPI_REDUCE(denCoeffs%ddnmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
102
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ddnmt(0:,:,:,jspin), 1)
103
    DEALLOCATE (r_b)
104

105
    !--> ener & sqal
Daniel Wortmann's avatar
Daniel Wortmann committed
106
    n=4*atoms%ntype
107
    ALLOCATE(r_b(n))
108
    CALL MPI_REDUCE(regCharges%ener(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
109
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%ener(:,:,jspin), 1)
110
    CALL MPI_REDUCE(regCharges%sqal(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
111
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%sqal(:,:,jspin), 1)
112
    DEALLOCATE (r_b)
113

114 115 116 117
    !--> svac & pvac
    IF ( input%film ) THEN
       n=2
       ALLOCATE(r_b(n))
118
       CALL MPI_REDUCE(regCharges%svac(:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
119
       IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%svac(:,jspin), 1)
120
       CALL MPI_REDUCE(regCharges%pvac(:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
121
       IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%pvac(:,jspin), 1)
122 123
       DEALLOCATE (r_b)
    ENDIF
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167

    !collect DOS stuff
    n = SIZE(dos%jsym,1)*SIZE(dos%jsym,2)
    ALLOCATE(i_b(n))
    CALL MPI_REDUCE(dos%jsym(:,:,jspin),i_b,n,MPI_INTEGER,MPI_SUM,0, MPI_COMM_WORLD,ierr)
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, i_b, 1, dos%jsym(:,:,jspin), 1)
    DEALLOCATE (i_b)

    n = SIZE(dos%ksym,1)*SIZE(dos%ksym,2)
    ALLOCATE(i_b(n))
    CALL MPI_REDUCE(dos%ksym(:,:,jspin),i_b,n,MPI_INTEGER,MPI_SUM,0, MPI_COMM_WORLD,ierr)
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, i_b, 1, dos%ksym(:,:,jspin), 1)
    DEALLOCATE (i_b)

    n = SIZE(dos%qis,1)*SIZE(dos%qis,2)
    ALLOCATE(r_b(n))
    CALL MPI_REDUCE(dos%qis(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qis(:,:,jspin), 1)
    DEALLOCATE (r_b)

    n = SIZE(dos%qal,1)*SIZE(dos%qal,2)*SIZE(dos%qal,3)*SIZE(dos%qal,4)
    ALLOCATE(r_b(n))
    CALL MPI_REDUCE(dos%qal(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qal(0:,:,:,:,jspin), 1)
    DEALLOCATE (r_b)

    n = SIZE(dos%qvac,1)*SIZE(dos%qvac,2)*SIZE(dos%qvac,3)
    ALLOCATE(r_b(n))
    CALL MPI_REDUCE(dos%qvac(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qvac(:,:,:,jspin), 1)
    DEALLOCATE (r_b)

    n = SIZE(dos%qvlay,1)*SIZE(dos%qvlay,2)*SIZE(dos%qvlay,3)*SIZE(dos%qvlay,4)
    ALLOCATE(r_b(n))
    CALL MPI_REDUCE(dos%qvlay(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qvlay(:,:,:,:,jspin), 1)
    DEALLOCATE (r_b)

    n = SIZE(dos%qstars,1)*SIZE(dos%qstars,2)*SIZE(dos%qstars,3)*SIZE(dos%qstars,4)*SIZE(dos%qstars,5)
    ALLOCATE(c_b(n))
    CALL MPI_REDUCE(dos%qstars(:,:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
    IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, c_b, 1, dos%qstars(:,:,:,:,:,jspin), 1)
    DEALLOCATE (c_b)

168 169
    ! -> Collect force
    IF (input%l_f) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
170
       n=3*atoms%ntype
171
       ALLOCATE(r_b(n))
172
       CALL MPI_REDUCE(results%force(1,1,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
173
       IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, results%force(1,1,jspin), 1)
174 175
       DEALLOCATE (r_b)
    ENDIF
176

177 178 179
    ! -> Optional the LO-coefficients: aclo,bclo,enerlo,cclo,acnmt,bcnmt,ccnmt
    IF (atoms%nlod.GE.1) THEN

Daniel Wortmann's avatar
Daniel Wortmann committed
180
       n=atoms%nlod*atoms%ntype 
181
       ALLOCATE (r_b(n))
182
       CALL MPI_REDUCE(denCoeffs%aclo(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
183
       IF (mpi%irank.EQ.0) THEN
184
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%aclo(:,:,jspin), 1)
185
       ENDIF
186
       CALL MPI_REDUCE(denCoeffs%bclo(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
187
       IF (mpi%irank.EQ.0) THEN
188
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%bclo(:,:,jspin), 1)
189
       ENDIF
190
       CALL MPI_REDUCE(regCharges%enerlo(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
191
       IF (mpi%irank.EQ.0) THEN
192
          CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%enerlo(:,:,jspin), 1)
193
       ENDIF
194
       CALL MPI_REDUCE(regCharges%sqlo(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
195
       IF (mpi%irank.EQ.0) THEN
196
          CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%sqlo(:,:,jspin), 1)
197 198 199
       ENDIF
       DEALLOCATE (r_b)

Daniel Wortmann's avatar
Daniel Wortmann committed
200
       n = atoms%nlod * atoms%nlod * atoms%ntype
201
       ALLOCATE (r_b(n))
202
       CALL MPI_REDUCE(denCoeffs%cclo(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
203
       IF (mpi%irank.EQ.0) THEN
204
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%cclo(:,:,:,jspin), 1)
205 206 207
       ENDIF
       DEALLOCATE (r_b)

Daniel Wortmann's avatar
Daniel Wortmann committed
208
       n = (atoms%lmaxd+1) * atoms%ntype * atoms%nlod * sphhar%nlhd
209
       ALLOCATE (r_b(n))
210
       CALL MPI_REDUCE(denCoeffs%acnmt(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
211
       IF (mpi%irank.EQ.0) THEN
212
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%acnmt(0:,:,:,:,jspin), 1)
213
       ENDIF
214
       CALL MPI_REDUCE(denCoeffs%bcnmt(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
215
       IF (mpi%irank.EQ.0) THEN
216
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%bcnmt(0:,:,:,:,jspin), 1)
217 218 219
       ENDIF
       DEALLOCATE (r_b)

Daniel Wortmann's avatar
Daniel Wortmann committed
220
       n = atoms%ntype * sphhar%nlhd * atoms%nlod**2
221
       ALLOCATE (r_b(n))
222
       CALL MPI_REDUCE(denCoeffs%ccnmt(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
223
       IF (mpi%irank.EQ.0) THEN
224
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ccnmt(:,:,:,:,jspin), 1)
225 226 227 228
       ENDIF
       DEALLOCATE (r_b)

    ENDIF
229

230 231 232
    ! ->  Now the SOC - stuff: orb, orblo and orblo
    IF (noco%l_soc) THEN
       ! orb
Daniel Wortmann's avatar
Daniel Wortmann committed
233
       n=(atoms%lmaxd+1)*(2*atoms%lmaxd+1)*atoms%ntype
234
       ALLOCATE (r_b(n))
235
       CALL MPI_REDUCE(orb%uu(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
236
       IF (mpi%irank.EQ.0) THEN
237
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%uu(:,:,:,jspin), 1)
238
       ENDIF
239
       CALL MPI_REDUCE(orb%dd(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
240
       IF (mpi%irank.EQ.0) THEN
241
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%dd(:,:,:,jspin), 1)
242 243 244 245
       ENDIF
       DEALLOCATE (r_b)

       ALLOCATE (c_b(n))
246
       CALL MPI_REDUCE(orb%uup(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
247
       IF (mpi%irank.EQ.0) THEN
248
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uup(:,:,:,jspin), 1)
249
       ENDIF
250
       CALL MPI_REDUCE(orb%ddp(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
251
       IF (mpi%irank.EQ.0) THEN
252
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%ddp(:,:,:,jspin), 1)
253
       ENDIF
254
       CALL MPI_REDUCE(orb%uum(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
255
       IF (mpi%irank.EQ.0) THEN
256
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uum(:,:,:,jspin), 1)
257
       ENDIF
258
       CALL MPI_REDUCE(orb%ddm(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
259
       IF (mpi%irank.EQ.0) THEN
260
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%ddm(:,:,:,jspin), 1)
261 262
       ENDIF
       DEALLOCATE (c_b)
263

Daniel Wortmann's avatar
Daniel Wortmann committed
264
       n = atoms%nlod * (2*atoms%llod+1) * atoms%ntype
265
       ALLOCATE (r_b(n))
266
       CALL MPI_REDUCE(orb%uulo(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
267
       IF (mpi%irank.EQ.0) THEN
268
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%uulo(:,:,:,jspin), 1)
269
       ENDIF
270
       CALL MPI_REDUCE(orb%dulo(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
271
       IF (mpi%irank.EQ.0) THEN
272
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%dulo(:,:,:,jspin), 1)
273 274 275 276
       ENDIF
       DEALLOCATE (r_b)

       ALLOCATE (c_b(n))
277
       CALL MPI_REDUCE(orb%uulop(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
278
       IF (mpi%irank.EQ.0) THEN
279
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uulop(:,:,:,jspin), 1)
280
       ENDIF
281
       CALL MPI_REDUCE(orb%dulop(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
282
       IF (mpi%irank.EQ.0) THEN
283
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%dulop(:,:,:,jspin), 1)
284
       ENDIF
285
       CALL MPI_REDUCE(orb%uulom(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
286
       IF (mpi%irank.EQ.0) THEN
287
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uulom(:,:,:,jspin), 1)
288
       ENDIF
289
       CALL MPI_REDUCE(orb%dulom(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
290
       IF (mpi%irank.EQ.0) THEN
291
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%dulom(:,:,:,jspin), 1)
292 293
       ENDIF
       DEALLOCATE (c_b)
294

Daniel Wortmann's avatar
Daniel Wortmann committed
295
       n = atoms%nlod * atoms%nlod * (2*atoms%llod+1) * atoms%ntype
296
       ALLOCATE (r_b(n))
297
       CALL MPI_REDUCE(orb%z(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
298
       IF (mpi%irank.EQ.0) THEN
299
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%z(:,:,:,:,jspin), 1)
300 301 302 303
       ENDIF
       DEALLOCATE (r_b)

       ALLOCATE (c_b(n))
304
       CALL MPI_REDUCE(orb%p(:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
305
       IF (mpi%irank.EQ.0) THEN
306
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%p(:,:,:,:,jspin), 1)
307
       ENDIF
308
       CALL MPI_REDUCE(orb%m(:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
309
       IF (mpi%irank.EQ.0) THEN
310
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%m(:,:,:,:,jspin), 1)
311 312 313 314 315 316 317 318
       ENDIF
       DEALLOCATE (c_b)

    ENDIF

    ! -> Collect the noco staff: 
    IF ( noco%l_noco .AND. jspin.EQ.1 ) THEN

319
       n = stars%ng3
320
       ALLOCATE(c_b(n))
Gregor Michalicek's avatar
Gregor Michalicek committed
321
       CALL MPI_REDUCE(den%pw(:,3),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
322
       IF (mpi%irank.EQ.0) THEN
Gregor Michalicek's avatar
Gregor Michalicek committed
323
          CALL CPP_BLAS_ccopy(n, c_b, 1, den%pw(:,3), 1)
324 325 326 327 328 329 330
       ENDIF
       DEALLOCATE (c_b)
       !
       IF (input%film) THEN

          n = vacuum%nmzxyd*(oneD%odi%n2d-1)*2
          ALLOCATE(c_b(n))
Gregor Michalicek's avatar
Gregor Michalicek committed
331
          CALL MPI_REDUCE(den%vacxy(:,:,:,3),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
332
          IF (mpi%irank.EQ.0) THEN
Gregor Michalicek's avatar
Gregor Michalicek committed
333
             CALL CPP_BLAS_ccopy(n, c_b, 1, den%vacxy(:,:,:,3), 1)
334 335 336
          ENDIF
          DEALLOCATE (c_b)
          !
Gregor Michalicek's avatar
Gregor Michalicek committed
337 338 339
          n = vacuum%nmzd*2*2
          ALLOCATE(r_b(n))
          CALL MPI_REDUCE(den%vacz(:,:,3:4),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
340
          IF (mpi%irank.EQ.0) THEN
Gregor Michalicek's avatar
Gregor Michalicek committed
341
             CALL CPP_BLAS_ccopy(n, r_b, 1, den%vacz(:,:,3:4), 1)
342
          ENDIF
Gregor Michalicek's avatar
Gregor Michalicek committed
343
          DEALLOCATE (r_b)
344 345 346 347 348

       ENDIF ! input%film


       IF (noco%l_mperp) THEN
349

350
          ! -->     for (spin)-off diagonal part of muffin-tin
Daniel Wortmann's avatar
Daniel Wortmann committed
351
          n = (atoms%lmaxd+1) * atoms%ntype
352
          ALLOCATE(c_b(n))
353
          CALL MPI_REDUCE(denCoeffsOffdiag%uu21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
354
          IF (mpi%irank.EQ.0) THEN
355
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uu21(:,:), 1)
356
          ENDIF
357
          CALL MPI_REDUCE(denCoeffsOffdiag%ud21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
358
          IF (mpi%irank.EQ.0) THEN
359
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ud21(:,:), 1)
360
          ENDIF
361
          CALL MPI_REDUCE(denCoeffsOffdiag%du21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
362
          IF (mpi%irank.EQ.0) THEN
363
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%du21(:,:), 1)
364
          ENDIF
365
          CALL MPI_REDUCE(denCoeffsOffdiag%dd21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
366
          IF (mpi%irank.EQ.0) THEN
367
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dd21(:,:), 1)
368 369
          ENDIF
          DEALLOCATE (c_b)
370

371
          ! -->     lo,u coeff's:
Daniel Wortmann's avatar
Daniel Wortmann committed
372
          n = atoms%nlod * atoms%ntype
373
          ALLOCATE(c_b(n))
374
          CALL MPI_REDUCE(denCoeffsOffdiag%uulo21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
375
          IF (mpi%irank.EQ.0) THEN
376
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uulo21(:,:), 1)
377
          ENDIF
378
          CALL MPI_REDUCE(denCoeffsOffdiag%ulou21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
379
          IF (mpi%irank.EQ.0) THEN
380
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ulou21(:,:), 1)
381
          ENDIF
382
          CALL MPI_REDUCE(denCoeffsOffdiag%dulo21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
383
          IF (mpi%irank.EQ.0) THEN
384
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dulo21(:,:), 1)
385
          ENDIF
386
          CALL MPI_REDUCE(denCoeffsOffdiag%ulod21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
387
          IF (mpi%irank.EQ.0) THEN
388
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ulod21(:,:), 1)
389 390
          ENDIF
          DEALLOCATE (c_b)
391

392
          ! -->     lo,lo' coeff's:
Daniel Wortmann's avatar
Daniel Wortmann committed
393
          n = atoms%nlod*atoms%nlod*atoms%ntype
394
          ALLOCATE(c_b(n))
395
          CALL MPI_REDUCE(denCoeffsOffdiag%uloulop21,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
396
          IF (mpi%irank.EQ.0) THEN
397
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uloulop21, 1)
398 399 400
          ENDIF
          DEALLOCATE (c_b)

401
          IF (denCoeffsOffdiag%l_fmpl) THEN
402

403
             !-->        Full magnetization plots: Collect uunmt21, etc.
Daniel Wortmann's avatar
Daniel Wortmann committed
404
             n = (atoms%lmaxd+1)**2 *sphhar%nlhd*atoms%ntype
405
             ALLOCATE(c_b(n))
406
             CALL MPI_REDUCE(denCoeffsOffdiag%uunmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0 ,MPI_COMM_WORLD,ierr)
407
             IF (mpi%irank.EQ.0) THEN
408
                CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uunmt21, 1)
409
             ENDIF
410
             CALL MPI_REDUCE(denCoeffsOffdiag%udnmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0 ,MPI_COMM_WORLD,ierr)
411
             IF (mpi%irank.EQ.0) THEN
412
                CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%udnmt21, 1)
413
             ENDIF
414
             CALL MPI_REDUCE(denCoeffsOffdiag%dunmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0 ,MPI_COMM_WORLD,ierr)
415
             IF (mpi%irank.EQ.0) THEN
416
                CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dunmt21, 1)
417
             ENDIF
418
             CALL MPI_REDUCE(denCoeffsOffdiag%ddnmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0 ,MPI_COMM_WORLD,ierr)
419
             IF (mpi%irank.EQ.0) THEN
420
                CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ddnmt21, 1)
421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439
             ENDIF
             DEALLOCATE (c_b)

          ENDIF ! fmpl
       ENDIF  ! mperp
    ENDIF   ! noco

    !+lda+U
    IF ( atoms%n_u.GT.0 ) THEN
       n = 49*atoms%n_u 
       ALLOCATE(c_b(n))
       CALL MPI_REDUCE(n_mmp,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
       IF (mpi%irank.EQ.0) THEN
          CALL CPP_BLAS_ccopy(n, c_b, 1, n_mmp, 1)
       ENDIF
       DEALLOCATE (c_b)
    ENDIF
    !-lda+U

440 441
    CALL timestop("mpi_col_den")

442 443
  END SUBROUTINE mpi_col_den
END MODULE m_mpi_col_den