mpi_col_den.F90 17.1 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 13
  SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
       input, noco,l_fmpl,jspin,llpd,rhtxy,rht,qpw,ener,&
14 15 16
       sqal,results,svac,pvac,denCoeffs,sqlo,&
       enerlo,orb,&
       denCoeffsOffdiag,den,n_mmp)
17 18 19
    !
#include"cpp_double.h"
    USE m_types
Gregor Michalicek's avatar
Gregor Michalicek committed
20
    USE m_constants
21 22
    IMPLICIT NONE

23 24 25 26 27 28 29 30 31
    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
32
    TYPE(t_potden),INTENT(INOUT) :: den
33 34 35 36 37 38 39
    INCLUDE 'mpif.h'
    ! ..
    ! ..  Scalar Arguments ..
    INTEGER, INTENT (IN) :: jspin,llpd
    LOGICAL, INTENT (IN) :: l_fmpl
    ! ..
    ! ..  Array Arguments ..
40
    COMPLEX, INTENT (INOUT) :: qpw(stars%ng3)
41 42
    COMPLEX, INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)
    REAL,    INTENT (INOUT) :: rht(vacuum%nmzd,2) 
Daniel Wortmann's avatar
Daniel Wortmann committed
43
    REAL,    INTENT (INOUT) :: ener(0:3,atoms%ntype),sqal(0:3,atoms%ntype)
44
    REAL,    INTENT (INOUT) :: svac(2),pvac(2)
Daniel Wortmann's avatar
Daniel Wortmann committed
45
    REAL,  INTENT (INOUT) :: sqlo(atoms%nlod,atoms%ntype),enerlo(atoms%nlod,atoms%ntype)
Gregor Michalicek's avatar
Gregor Michalicek committed
46
    COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
47 48 49
    TYPE (t_orb),              INTENT(INOUT) :: orb
    TYPE (t_denCoeffs),        INTENT(INOUT) :: denCoeffs
    TYPE (t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
    ! ..
    ! ..  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()
    !
65
    n = stars%ng3
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 95 96 97 98
    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()
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
99
    n = (atoms%lmaxd+1)*atoms%ntype
100
    ALLOCATE(r_b(n))
101
    CALL MPI_REDUCE(denCoeffs%uu(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%uu(0:,:,jspin), 1)
104
    ENDIF
105
    CALL MPI_REDUCE(denCoeffs%du(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%du(0:,:,jspin), 1)
108
    ENDIF
109
    CALL MPI_REDUCE(denCoeffs%dd(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
110
    IF (mpi%irank.EQ.0) THEN
111
       CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dd(0:,:,jspin), 1)
112 113 114 115 116
    ENDIF
    DEALLOCATE (r_b)
    !
    !--> Collect uunmt,udnmt,dunmt,ddnmt
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
117
    n = (llpd+1)*sphhar%nlhd*atoms%ntype
118
    ALLOCATE(r_b(n))
119
    CALL MPI_REDUCE(denCoeffs%uunmt(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%uunmt(0:,:,:,jspin), 1)
122
    ENDIF
123
    CALL MPI_REDUCE(denCoeffs%udnmt(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%udnmt(0:,:,:,jspin), 1)
126
    ENDIF
127
    CALL MPI_REDUCE(denCoeffs%dunmt(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%dunmt(0:,:,:,jspin), 1)
130
    ENDIF
131
    CALL MPI_REDUCE(denCoeffs%ddnmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
132
    IF (mpi%irank.EQ.0) THEN
133
       CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ddnmt(0:,:,:,jspin), 1)
134 135 136 137 138
    ENDIF
    DEALLOCATE (r_b)
    !
    !--> ener & sqal
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
139
    n=4*atoms%ntype
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 168 169 170 171 172
    ALLOCATE(r_b(n))
    CALL MPI_REDUCE(ener,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, ener, 1)
    ENDIF
    CALL MPI_REDUCE(sqal,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, sqal, 1)
    ENDIF
    DEALLOCATE (r_b)
    !
    !--> svac & pvac
    !
    IF ( input%film ) THEN

       n=2
       ALLOCATE(r_b(n))
       CALL MPI_REDUCE(svac,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, svac, 1)
       ENDIF
       CALL MPI_REDUCE(pvac,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, pvac, 1)
       ENDIF
       DEALLOCATE (r_b)

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

Daniel Wortmann's avatar
Daniel Wortmann committed
173
       n=3*atoms%ntype
174
       ALLOCATE(r_b(n))
175
       CALL MPI_REDUCE(results%force(1,1,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
176
       IF (mpi%irank.EQ.0) THEN
177
          CALL CPP_BLAS_scopy(n, r_b, 1, results%force(1,1,jspin), 1)
178 179 180 181 182 183 184 185 186
       ENDIF
       DEALLOCATE (r_b)

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

Daniel Wortmann's avatar
Daniel Wortmann committed
187
       n=atoms%nlod*atoms%ntype 
188
       ALLOCATE (r_b(n))
189
       CALL MPI_REDUCE(denCoeffs%aclo(:,:,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%aclo(:,:,jspin), 1)
192
       ENDIF
193
       CALL MPI_REDUCE(denCoeffs%bclo(:,:,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, denCoeffs%bclo(:,:,jspin), 1)
196 197 198 199 200 201 202 203 204 205 206
       ENDIF
       CALL MPI_REDUCE(enerlo,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, enerlo, 1)
       ENDIF
       CALL MPI_REDUCE(sqlo,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, sqlo, 1)
       ENDIF
       DEALLOCATE (r_b)

Daniel Wortmann's avatar
Daniel Wortmann committed
207
       n = atoms%nlod * atoms%nlod * atoms%ntype
208
       ALLOCATE (r_b(n))
209
       CALL MPI_REDUCE(denCoeffs%cclo(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
210
       IF (mpi%irank.EQ.0) THEN
211
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%cclo(:,:,:,jspin), 1)
212 213 214
       ENDIF
       DEALLOCATE (r_b)

Daniel Wortmann's avatar
Daniel Wortmann committed
215
       n = (atoms%lmaxd+1) * atoms%ntype * atoms%nlod * sphhar%nlhd
216
       ALLOCATE (r_b(n))
217
       CALL MPI_REDUCE(denCoeffs%acnmt(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%acnmt(0:,:,:,:,jspin), 1)
220
       ENDIF
221
       CALL MPI_REDUCE(denCoeffs%bcnmt(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
222
       IF (mpi%irank.EQ.0) THEN
223
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%bcnmt(0:,:,:,:,jspin), 1)
224 225 226
       ENDIF
       DEALLOCATE (r_b)

Daniel Wortmann's avatar
Daniel Wortmann committed
227
       n = atoms%ntype * sphhar%nlhd * atoms%nlod**2
228
       ALLOCATE (r_b(n))
229
       CALL MPI_REDUCE(denCoeffs%ccnmt(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
230
       IF (mpi%irank.EQ.0) THEN
231
          CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ccnmt(:,:,:,:,jspin), 1)
232 233 234 235 236 237 238 239 240 241
       ENDIF
       DEALLOCATE (r_b)

    ENDIF
    !
    ! ->  Now the SOC - stuff: orb, orblo and orblo
    !
    IF (noco%l_soc) THEN
       !
       ! orb
Daniel Wortmann's avatar
Daniel Wortmann committed
242
       n=(atoms%lmaxd+1)*(2*atoms%lmaxd+1)*atoms%ntype
243
       ALLOCATE (r_b(n))
244
       CALL MPI_REDUCE(orb%uu(:,:,:,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%uu(:,:,:,jspin), 1)
247
       ENDIF
248
       CALL MPI_REDUCE(orb%dd(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
249
       IF (mpi%irank.EQ.0) THEN
250
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%dd(:,:,:,jspin), 1)
251 252 253 254
       ENDIF
       DEALLOCATE (r_b)

       ALLOCATE (c_b(n))
255
       CALL MPI_REDUCE(orb%uup(:,:,:,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%uup(:,:,:,jspin), 1)
258
       ENDIF
259
       CALL MPI_REDUCE(orb%ddp(:,:,:,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%ddp(:,:,:,jspin), 1)
262
       ENDIF
263
       CALL MPI_REDUCE(orb%uum(:,:,:,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%uum(:,:,:,jspin), 1)
266
       ENDIF
267
       CALL MPI_REDUCE(orb%ddm(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
268
       IF (mpi%irank.EQ.0) THEN
269
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%ddm(:,:,:,jspin), 1)
270 271
       ENDIF
       DEALLOCATE (c_b)
272

Daniel Wortmann's avatar
Daniel Wortmann committed
273
       n = atoms%nlod * (2*atoms%llod+1) * atoms%ntype
274
       ALLOCATE (r_b(n))
275
       CALL MPI_REDUCE(orb%uulo(:,:,:,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%uulo(:,:,:,jspin), 1)
278
       ENDIF
279
       CALL MPI_REDUCE(orb%dulo(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
280
       IF (mpi%irank.EQ.0) THEN
281
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%dulo(:,:,:,jspin), 1)
282 283 284 285
       ENDIF
       DEALLOCATE (r_b)

       ALLOCATE (c_b(n))
286
       CALL MPI_REDUCE(orb%uulop(:,:,:,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%uulop(:,:,:,jspin), 1)
289
       ENDIF
290
       CALL MPI_REDUCE(orb%dulop(:,:,:,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%dulop(:,:,:,jspin), 1)
293
       ENDIF
294
       CALL MPI_REDUCE(orb%uulom(:,:,:,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%uulom(:,:,:,jspin), 1)
297
       ENDIF
298
       CALL MPI_REDUCE(orb%dulom(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
299
       IF (mpi%irank.EQ.0) THEN
300
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%dulom(:,:,:,jspin), 1)
301 302
       ENDIF
       DEALLOCATE (c_b)
303

Daniel Wortmann's avatar
Daniel Wortmann committed
304
       n = atoms%nlod * atoms%nlod * (2*atoms%llod+1) * atoms%ntype
305
       ALLOCATE (r_b(n))
306
       CALL MPI_REDUCE(orb%z(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
307
       IF (mpi%irank.EQ.0) THEN
308
          CALL CPP_BLAS_scopy(n, r_b, 1, orb%z(:,:,:,:,jspin), 1)
309 310 311 312
       ENDIF
       DEALLOCATE (r_b)

       ALLOCATE (c_b(n))
313
       CALL MPI_REDUCE(orb%p(:,:,:,:,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%p(:,:,:,:,jspin), 1)
316
       ENDIF
317
       CALL MPI_REDUCE(orb%m(:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
318
       IF (mpi%irank.EQ.0) THEN
319
          CALL CPP_BLAS_ccopy(n, c_b, 1, orb%m(:,:,:,:,jspin), 1)
320 321 322 323 324 325 326 327 328 329
       ENDIF
       DEALLOCATE (c_b)

    ENDIF

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

330
       n = stars%ng3
331
       ALLOCATE(c_b(n))
Gregor Michalicek's avatar
Gregor Michalicek committed
332
       CALL MPI_REDUCE(den%pw(:,3),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
333
       IF (mpi%irank.EQ.0) THEN
Gregor Michalicek's avatar
Gregor Michalicek committed
334
          CALL CPP_BLAS_ccopy(n, c_b, 1, den%pw(:,3), 1)
335 336 337 338 339 340 341
       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
342
          CALL MPI_REDUCE(den%vacxy(:,:,:,3),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
343
          IF (mpi%irank.EQ.0) THEN
Gregor Michalicek's avatar
Gregor Michalicek committed
344
             CALL CPP_BLAS_ccopy(n, c_b, 1, den%vacxy(:,:,:,3), 1)
345 346 347
          ENDIF
          DEALLOCATE (c_b)
          !
Gregor Michalicek's avatar
Gregor Michalicek committed
348 349 350
          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)
351
          IF (mpi%irank.EQ.0) THEN
Gregor Michalicek's avatar
Gregor Michalicek committed
352
             CALL CPP_BLAS_ccopy(n, r_b, 1, den%vacz(:,:,3:4), 1)
353
          ENDIF
Gregor Michalicek's avatar
Gregor Michalicek committed
354
          DEALLOCATE (r_b)
355 356 357 358 359 360 361 362

       ENDIF ! input%film


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

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