mpi_col_den.F90 17.2 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,&
13 14 15
       input, noco,l_fmpl,jspin,llpd,rhtxy,rht,qpw,regCharges,&
       results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp)

16 17
#include"cpp_double.h"
    USE m_types
18
    USE m_constants
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
30
    TYPE(t_potden),INTENT(INOUT) :: den
31 32 33 34 35 36 37
    INCLUDE 'mpif.h'
    ! ..
    ! ..  Scalar Arguments ..
    INTEGER, INTENT (IN) :: jspin,llpd
    LOGICAL, INTENT (IN) :: l_fmpl
    ! ..
    ! ..  Array Arguments ..
38
    COMPLEX, INTENT (INOUT) :: qpw(stars%ng3)
39
    COMPLEX, INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)
40
    REAL,    INTENT (INOUT) :: rht(vacuum%nmzd,2)
41
    COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
42 43 44
    TYPE (t_orb),              INTENT(INOUT) :: orb
    TYPE (t_denCoeffs),        INTENT(INOUT) :: denCoeffs
    TYPE (t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
45
    TYPE (t_regionCharges),    INTENT(INOUT) :: regCharges
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
    ! ..
    ! ..  Local Scalars ..
    INTEGER :: n
    ! ..
    ! ..  Local Arrays ..
    INTEGER :: ierr(3)
    COMPLEX, ALLOCATABLE :: c_b(:)
    REAL,    ALLOCATABLE :: r_b(:)
    ! ..
    ! ..  External Subroutines
    EXTERNAL CPP_BLAS_scopy,CPP_BLAS_ccopy,MPI_REDUCE

    !
    ! -> Collect qpw()
    !
61
    n = stars%ng3
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
    ALLOCATE(c_b(n))
    CALL MPI_REDUCE(qpw,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, qpw, 1)
    ENDIF
    DEALLOCATE (c_b)
    !
    ! -> Collect rhtxy()
    !
    IF (input%film) THEN

       n = vacuum%nmzxyd*(oneD%odi%n2d-1)*2
       ALLOCATE(c_b(n))
       CALL MPI_REDUCE(rhtxy,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, rhtxy, 1)
       ENDIF
       DEALLOCATE (c_b)
       !
       ! -> Collect rht()
       !
       n = vacuum%nmzd*2
       ALLOCATE(r_b(n))
       CALL MPI_REDUCE(rht,r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
       IF (mpi%irank.EQ.0) THEN
          CALL CPP_BLAS_scopy(n, r_b, 1, rht, 1)
       ENDIF
       DEALLOCATE (r_b)

    ENDIF
    !
    ! -> Collect uu(),ud() and dd()
    !
95
    n = (atoms%lmaxd+1)*atoms%ntype
96
    ALLOCATE(r_b(n))
97
    CALL MPI_REDUCE(denCoeffs%uu(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
98
    IF (mpi%irank.EQ.0) THEN
99
       CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uu(0:,:,jspin), 1)
100
    ENDIF
101
    CALL MPI_REDUCE(denCoeffs%du(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
102
    IF (mpi%irank.EQ.0) THEN
103
       CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%du(0:,:,jspin), 1)
104
    ENDIF
105
    CALL MPI_REDUCE(denCoeffs%dd(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
106
    IF (mpi%irank.EQ.0) THEN
107
       CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dd(0:,:,jspin), 1)
108 109 110 111 112
    ENDIF
    DEALLOCATE (r_b)
    !
    !--> Collect uunmt,udnmt,dunmt,ddnmt
    !
113
    n = (llpd+1)*sphhar%nlhd*atoms%ntype
114
    ALLOCATE(r_b(n))
115
    CALL MPI_REDUCE(denCoeffs%uunmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
116
    IF (mpi%irank.EQ.0) THEN
117
       CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uunmt(0:,:,:,jspin), 1)
118
    ENDIF
119
    CALL MPI_REDUCE(denCoeffs%udnmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
120
    IF (mpi%irank.EQ.0) THEN
121
       CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%udnmt(0:,:,:,jspin), 1)
122
    ENDIF
123
    CALL MPI_REDUCE(denCoeffs%dunmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
124
    IF (mpi%irank.EQ.0) THEN
125
       CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dunmt(0:,:,:,jspin), 1)
126
    ENDIF
127
    CALL MPI_REDUCE(denCoeffs%ddnmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
128
    IF (mpi%irank.EQ.0) THEN
129
       CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ddnmt(0:,:,:,jspin), 1)
130 131 132 133 134
    ENDIF
    DEALLOCATE (r_b)
    !
    !--> ener & sqal
    !
135
    n=4*atoms%ntype
136
    ALLOCATE(r_b(n))
137
    CALL MPI_REDUCE(regCharges%ener(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
138
    IF (mpi%irank.EQ.0) THEN
139
       CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%ener(:,:,jspin), 1)
140
    ENDIF
141
    CALL MPI_REDUCE(regCharges%sqal(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
142
    IF (mpi%irank.EQ.0) THEN
143
       CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%sqal(:,:,jspin), 1)
144 145 146 147 148 149 150 151 152
    ENDIF
    DEALLOCATE (r_b)
    !
    !--> svac & pvac
    !
    IF ( input%film ) THEN

       n=2
       ALLOCATE(r_b(n))
153
       CALL MPI_REDUCE(regCharges%svac(:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
154
       IF (mpi%irank.EQ.0) THEN
155
          CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%svac(:,jspin), 1)
156
       ENDIF
157
       CALL MPI_REDUCE(regCharges%pvac(:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
158
       IF (mpi%irank.EQ.0) THEN
159
          CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%pvac(:,jspin), 1)
160 161 162 163 164 165 166 167 168
       ENDIF
       DEALLOCATE (r_b)

    ENDIF
    !
    ! -> Collect force
    !   
    IF (input%l_f) THEN

169
       n=3*atoms%ntype
170
       ALLOCATE(r_b(n))
171
       CALL MPI_REDUCE(results%force(1,1,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
172
       IF (mpi%irank.EQ.0) THEN
173
          CALL CPP_BLAS_scopy(n, r_b, 1, results%force(1,1,jspin), 1)
174 175 176 177 178 179 180 181 182
       ENDIF
       DEALLOCATE (r_b)

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

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

203
       n = atoms%nlod * atoms%nlod * atoms%ntype
204
       ALLOCATE (r_b(n))
205
       CALL MPI_REDUCE(denCoeffs%cclo(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
206
       IF (mpi%irank.EQ.0) THEN
207
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%cclo(:,:,:,jspin), 1)
208 209 210
       ENDIF
       DEALLOCATE (r_b)

211
       n = (atoms%lmaxd+1) * atoms%ntype * atoms%nlod * sphhar%nlhd
212
       ALLOCATE (r_b(n))
213
       CALL MPI_REDUCE(denCoeffs%acnmt(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
214
       IF (mpi%irank.EQ.0) THEN
215
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%acnmt(0:,:,:,:,jspin), 1)
216
       ENDIF
217
       CALL MPI_REDUCE(denCoeffs%bcnmt(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
218
       IF (mpi%irank.EQ.0) THEN
219
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%bcnmt(0:,:,:,:,jspin), 1)
220 221 222
       ENDIF
       DEALLOCATE (r_b)

223
       n = atoms%ntype * sphhar%nlhd * atoms%nlod**2
224
       ALLOCATE (r_b(n))
225
       CALL MPI_REDUCE(denCoeffs%ccnmt(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
226
       IF (mpi%irank.EQ.0) THEN
227
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ccnmt(:,:,:,:,jspin), 1)
228 229 230 231 232 233 234 235 236 237
       ENDIF
       DEALLOCATE (r_b)

    ENDIF
    !
    ! ->  Now the SOC - stuff: orb, orblo and orblo
    !
    IF (noco%l_soc) THEN
       !
       ! orb
238
       n=(atoms%lmaxd+1)*(2*atoms%lmaxd+1)*atoms%ntype
239
       ALLOCATE (r_b(n))
240
       CALL MPI_REDUCE(orb%uu(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
241
       IF (mpi%irank.EQ.0) THEN
242
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%uu(:,:,:,jspin), 1)
243
       ENDIF
244
       CALL MPI_REDUCE(orb%dd(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
245
       IF (mpi%irank.EQ.0) THEN
246
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%dd(:,:,:,jspin), 1)
247 248 249 250
       ENDIF
       DEALLOCATE (r_b)

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

269
       n = atoms%nlod * (2*atoms%llod+1) * atoms%ntype
270
       ALLOCATE (r_b(n))
271
       CALL MPI_REDUCE(orb%uulo(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
272
       IF (mpi%irank.EQ.0) THEN
273
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%uulo(:,:,:,jspin), 1)
274
       ENDIF
275
       CALL MPI_REDUCE(orb%dulo(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
276
       IF (mpi%irank.EQ.0) THEN
277
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%dulo(:,:,:,jspin), 1)
278 279 280 281
       ENDIF
       DEALLOCATE (r_b)

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

300
       n = atoms%nlod * atoms%nlod * (2*atoms%llod+1) * atoms%ntype
301
       ALLOCATE (r_b(n))
302
       CALL MPI_REDUCE(orb%z(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
303
       IF (mpi%irank.EQ.0) THEN
304
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%z(:,:,:,:,jspin), 1)
305 306 307 308
       ENDIF
       DEALLOCATE (r_b)

       ALLOCATE (c_b(n))
309
       CALL MPI_REDUCE(orb%p(:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
310
       IF (mpi%irank.EQ.0) THEN
311
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%p(:,:,:,:,jspin), 1)
312
       ENDIF
313
       CALL MPI_REDUCE(orb%m(:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
314
       IF (mpi%irank.EQ.0) THEN
315
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%m(:,:,:,:,jspin), 1)
316 317 318 319 320 321 322 323 324 325
       ENDIF
       DEALLOCATE (c_b)

    ENDIF

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

326
       n = stars%ng3
327
       ALLOCATE(c_b(n))
328
       CALL MPI_REDUCE(den%pw(:,3),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
329
       IF (mpi%irank.EQ.0) THEN
330
          CALL CPP_BLAS_ccopy(n, c_b, 1, den%pw(:,3), 1)
331 332 333 334 335 336 337
       ENDIF
       DEALLOCATE (c_b)
       !
       IF (input%film) THEN

          n = vacuum%nmzxyd*(oneD%odi%n2d-1)*2
          ALLOCATE(c_b(n))
338
          CALL MPI_REDUCE(den%vacxy(:,:,:,3),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
339
          IF (mpi%irank.EQ.0) THEN
340
             CALL CPP_BLAS_ccopy(n, c_b, 1, den%vacxy(:,:,:,3), 1)
341 342 343
          ENDIF
          DEALLOCATE (c_b)
          !
344 345 346
          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)
347
          IF (mpi%irank.EQ.0) THEN
348
             CALL CPP_BLAS_ccopy(n, r_b, 1, den%vacz(:,:,3:4), 1)
349
          ENDIF
350
          DEALLOCATE (r_b)
351 352 353 354 355 356 357 358

       ENDIF ! input%film


       IF (noco%l_mperp) THEN
          !
          ! -->     for (spin)-off diagonal part of muffin-tin
          !
359
          n = (atoms%lmaxd+1) * atoms%ntype
360
          ALLOCATE(c_b(n))
361
          CALL MPI_REDUCE(denCoeffsOffdiag%uu21(:,:),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%uu21(:,:), 1)
364
          ENDIF
365
          CALL MPI_REDUCE(denCoeffsOffdiag%ud21(:,:),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%ud21(:,:), 1)
368
          ENDIF
369
          CALL MPI_REDUCE(denCoeffsOffdiag%du21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
370
          IF (mpi%irank.EQ.0) THEN
371
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%du21(:,:), 1)
372
          ENDIF
373
          CALL MPI_REDUCE(denCoeffsOffdiag%dd21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
374
          IF (mpi%irank.EQ.0) THEN
375
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dd21(:,:), 1)
376 377 378 379 380
          ENDIF
          DEALLOCATE (c_b)
          !
          ! -->     lo,u coeff's:
          !
381
          n = atoms%nlod * atoms%ntype
382
          ALLOCATE(c_b(n))
383
          CALL MPI_REDUCE(denCoeffsOffdiag%uulo21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
384
          IF (mpi%irank.EQ.0) THEN
385
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uulo21(:,:), 1)
386
          ENDIF
387
          CALL MPI_REDUCE(denCoeffsOffdiag%ulou21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
388
          IF (mpi%irank.EQ.0) THEN
389
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ulou21(:,:), 1)
390
          ENDIF
391
          CALL MPI_REDUCE(denCoeffsOffdiag%dulo21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
392
          IF (mpi%irank.EQ.0) THEN
393
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dulo21(:,:), 1)
394
          ENDIF
395
          CALL MPI_REDUCE(denCoeffsOffdiag%ulod21(:,:),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%ulod21(:,:), 1)
398 399 400 401 402
          ENDIF
          DEALLOCATE (c_b)
          !
          ! -->     lo,lo' coeff's:
          !
403
          n = atoms%nlod*atoms%nlod*atoms%ntype
404
          ALLOCATE(c_b(n))
405
          CALL MPI_REDUCE(denCoeffsOffdiag%uloulop21,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
406
          IF (mpi%irank.EQ.0) THEN
407
             CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uloulop21, 1)
408 409 410 411 412 413 414
          ENDIF
          DEALLOCATE (c_b)

          IF (l_fmpl) THEN
             !
             !-->        Full magnetization plots: Collect uunmt21, etc.
             !
415
             n = (atoms%lmaxd+1)**2 *sphhar%nlhd*atoms%ntype
416
             ALLOCATE(c_b(n))
417
             CALL MPI_REDUCE(denCoeffsOffdiag%uunmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0 ,MPI_COMM_WORLD,ierr)
418
             IF (mpi%irank.EQ.0) THEN
419
                CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%uunmt21, 1)
420
             ENDIF
421
             CALL MPI_REDUCE(denCoeffsOffdiag%udnmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0 ,MPI_COMM_WORLD,ierr)
422
             IF (mpi%irank.EQ.0) THEN
423
                CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%udnmt21, 1)
424
             ENDIF
425
             CALL MPI_REDUCE(denCoeffsOffdiag%dunmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0 ,MPI_COMM_WORLD,ierr)
426
             IF (mpi%irank.EQ.0) THEN
427
                CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dunmt21, 1)
428
             ENDIF
429
             CALL MPI_REDUCE(denCoeffsOffdiag%ddnmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0 ,MPI_COMM_WORLD,ierr)
430
             IF (mpi%irank.EQ.0) THEN
431
                CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ddnmt21, 1)
432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453
             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

    RETURN
  END SUBROUTINE mpi_col_den
END MODULE m_mpi_col_den