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
|