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 : MODULE m_types_potden
7 :
8 : !> Data type for the density or the potential
9 : TYPE t_potden
10 : INTEGER :: iter
11 : INTEGER :: potdenType
12 : COMPLEX,ALLOCATABLE :: pw(:,:),pw_w(:,:)
13 : ! mt(radial_grid, sphhar, atom, spin)
14 : REAL,ALLOCATABLE :: mt(:,:,:,:)
15 : COMPLEX,ALLOCATABLE :: vac(:,:,:,:)
16 : !For angles of density/potential in noco case
17 : REAL,ALLOCATABLE :: theta_pw(:)
18 : REAL,ALLOCATABLE :: phi_pw(:)
19 : REAL,ALLOCATABLE :: theta_vac(:,:,:)
20 : REAL,ALLOCATABLE :: phi_vac(:,:,:)
21 : REAL,ALLOCATABLE :: theta_mt(:,:)
22 : REAL,ALLOCATABLE :: phi_mt(:,:)
23 :
24 : ! Core density
25 : REAL, ALLOCATABLE :: qint(:,:)
26 : REAL, ALLOCATABLE :: tec(:,:)
27 : REAL, ALLOCATABLE :: mtCore(:,:,:)
28 :
29 : ! For density matrix and associated potential matrix
30 : COMPLEX, ALLOCATABLE :: mmpMat(:,:,:,:)
31 : ! additional density matrix for LDA+v
32 : COMPLEX, ALLOCATABLE :: nIJ_llp_mmp(:,:,:,:) ! m, m', i_pair, i_spin
33 :
34 : !this type contains two init routines that should be used to allocate
35 : !memory. You can either specify the datatypes or give the dimensions as integers
36 : !See implementation below!
37 : CONTAINS
38 : PROCEDURE :: init_potden_types
39 : PROCEDURE :: init_potden_simple
40 : PROCEDURE :: resetpotden
41 : PROCEDURE :: reset_dfpt
42 : GENERIC :: init=>init_potden_types,init_potden_simple
43 : PROCEDURE :: copy_both_spin
44 : PROCEDURE :: sum_both_spin
45 : procedure :: SpinsToChargeAndMagnetisation
46 : procedure :: ChargeAndMagnetisationToSpins
47 : procedure :: addPotDen
48 : procedure :: subPotDen
49 : procedure :: copyPotDen
50 : procedure :: distribute
51 : procedure :: collect
52 : END TYPE t_potden
53 :
54 : CONTAINS
55 664 : subroutine collect(this,fmpi_comm,the_other)
56 : use m_mpi_bc_tool
57 : #ifdef CPP_MPI
58 : use mpi
59 : #endif
60 : implicit none
61 : class(t_potden),INTENT(INOUT) :: this
62 : class(t_potden),OPTIONAL,INTENT(INOUT) :: the_other
63 : integer :: fmpi_comm
64 : #ifdef CPP_MPI
65 : INTEGER:: ierr,irank
66 664 : real,ALLOCATABLE::rtmp(:)
67 : complex,ALLOCATABLE::ctmp(:)
68 664 : CALL MPI_COMM_RANK(fmpi_comm,irank,ierr)
69 : !pw
70 3320 : ALLOCATE(ctmp(size(this%pw)))
71 1992 : CALL MPI_REDUCE(this%pw,ctmp,size(this%pw),MPI_DOUBLE_COMPLEX,MPI_SUM,0,fmpi_comm,ierr)
72 2992818 : if (irank==0) this%pw=reshape(ctmp,shape(this%pw))
73 664 : deallocate(ctmp)
74 : !mt
75 4648 : ALLOCATE(rtmp(size(this%mt)))
76 3320 : CALL MPI_REDUCE(this%mt,rtmp,size(this%mt),MPI_DOUBLE_PRECISION,MPI_SUM,0,fmpi_comm,ierr)
77 45127814 : if (irank==0) this%mt=reshape(rtmp,shape(this%mt))
78 664 : deallocate(rtmp)
79 664 : IF (PRESENT(the_other)) THEN
80 : !mt
81 0 : ALLOCATE(rtmp(size(the_other%mt)))
82 0 : CALL MPI_REDUCE(the_other%mt,rtmp,size(the_other%mt),MPI_DOUBLE_PRECISION,MPI_SUM,0,fmpi_comm,ierr)
83 0 : if (irank==0) the_other%mt=reshape(rtmp,shape(the_other%mt))
84 0 : deallocate(rtmp)
85 : END IF
86 : !vac
87 664 : if (allocated(this%vac)) THEN
88 4648 : ALLOCATE(ctmp(size(this%vac)))
89 3320 : CALL MPI_REDUCE(this%vac,ctmp,size(this%vac),MPI_DOUBLE_COMPLEX,MPI_SUM,0,fmpi_comm,ierr)
90 19267796 : if (irank==0) this%vac=reshape(ctmp,shape(this%vac))
91 664 : deallocate(ctmp)
92 : endif
93 : !density matrix
94 664 : if (allocated(this%mmpMat)) then
95 4648 : ALLOCATE(ctmp(size(this%mmpMat)))
96 3320 : CALL MPI_REDUCE(this%mmpMat,ctmp,size(this%mmpMat),MPI_DOUBLE_COMPLEX,MPI_SUM,0,fmpi_comm,ierr)
97 76738 : if (irank==0) this%mmpMat=reshape(ctmp,shape(this%mmpMat))
98 664 : deallocate(ctmp)
99 : endif
100 664 : if (allocated(this%nIJ_llp_mmp)) then
101 4648 : ALLOCATE(ctmp(size(this%nIJ_llp_mmp)))
102 3320 : CALL MPI_REDUCE(this%nIJ_llp_mmp,ctmp,size(this%nIJ_llp_mmp),MPI_DOUBLE_COMPLEX,MPI_SUM,0,fmpi_comm,ierr)
103 66820 : if (irank==0) this%nIJ_llp_mmp=reshape(ctmp,shape(this%nIJ_llp_mmp))
104 664 : deallocate(ctmp)
105 : endif
106 :
107 : #endif
108 1328 : end subroutine collect
109 :
110 6938 : subroutine distribute(this,fmpi_comm)
111 : use m_mpi_bc_tool
112 : #ifdef CPP_MPI
113 : use mpi
114 : #endif
115 : implicit none
116 : class(t_potden),INTENT(INOUT) :: this
117 : integer :: fmpi_comm
118 : #ifdef CPP_MPI
119 6938 : call mpi_bc(this%iter,0,fmpi_comm)
120 6938 : call mpi_bc(this%potdentype,0,fmpi_comm)
121 6938 : call mpi_bc(this%pw,0,fmpi_comm)
122 6938 : IF (ALLOCATED(this%pw_w)) CALL mpi_bc(this%pw_w ,0,fmpi_comm)
123 6938 : CALL mpi_bc(this%mt ,0,fmpi_comm)
124 6938 : IF (ALLOCATED(this%vac)) CALL mpi_bc(this%vac,0,fmpi_comm)
125 6938 : IF (ALLOCATED(this%mmpMat)) CALL mpi_bc(this%mmpMat,0,fmpi_comm)
126 6938 : IF (ALLOCATED(this%nIJ_llp_mmp)) CALL mpi_bc(this%nIJ_llp_mmp,0,fmpi_comm)
127 : #endif
128 6938 : end subroutine distribute
129 :
130 1032 : SUBROUTINE sum_both_spin(this,that)
131 : IMPLICIT NONE
132 : CLASS(t_potden),INTENT(INOUT) :: this
133 : TYPE(t_potden),INTENT(INOUT),OPTIONAL :: that
134 :
135 1032 : IF (PRESENT(that)) THEN
136 688 : IF (SIZE(this%pw,2)>1) THEN
137 15480680 : that%mt(:,0:,:,1)=this%mt(:,0:,:,1)+this%mt(:,0:,:,2)
138 898166 : that%pw(:,1)=this%pw(:,1)+this%pw(:,2)
139 2465010 : that%vac(:,:,:,1)=this%vac(:,:,:,1)+this%vac(:,:,:,2)
140 398 : IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)+this%pw_w(:,2)
141 : ELSE
142 8257096 : that%mt(:,0:,:,1)=this%mt(:,0:,:,1)
143 650394 : that%pw(:,1)=this%pw(:,1)
144 14983562 : that%vac(:,:,:,1)=this%vac(:,:,:,1)
145 290 : IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)
146 : ENDIF
147 : ELSE
148 344 : IF (SIZE(this%pw,2)>1) THEN
149 7740340 : this%mt(:,0:,:,1)=this%mt(:,0:,:,1)+this%mt(:,0:,:,2)
150 449083 : this%pw(:,1)=this%pw(:,1)+this%pw(:,2)
151 1232505 : this%vac(:,:,:,1)=this%vac(:,:,:,1)+this%vac(:,:,:,2)
152 199 : IF (ALLOCATED(this%pw_w)) this%pw_w(:,1)=this%pw_w(:,1)+this%pw_w(:,2)
153 : ENDIF
154 : END IF
155 1032 : END SUBROUTINE sum_both_spin
156 :
157 688 : SUBROUTINE copy_both_spin(this,that)
158 : IMPLICIT NONE
159 : CLASS(t_potden),INTENT(IN) :: this
160 : TYPE(t_potden),INTENT(INOUT) :: that
161 :
162 23737776 : that%mt(:,0:,:,1)=this%mt(:,0:,:,1)
163 1548560 : that%pw(:,1)=this%pw(:,1)
164 17448572 : that%vac(:,:,:,1)=this%vac(:,:,:,1)
165 1548560 : IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)
166 :
167 688 : IF (SIZE(that%mt,4)>1) THEN
168 15480680 : that%mt(:,0:,:,2)=this%mt(:,0:,:,1)
169 898166 : that%pw(:,2)=this%pw(:,1)
170 2465010 : that%vac(:,:,:,2)=this%vac(:,:,:,1)
171 898166 : IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,2)=this%pw_w(:,1)
172 : END IF
173 688 : END SUBROUTINE copy_both_spin
174 :
175 9 : subroutine SpinsToChargeAndMagnetisation( den )
176 : implicit none
177 : class(t_potden), intent(inout) :: den
178 : !type(t_potden), intent(inout) :: charge_magn
179 :
180 9 : type(t_potden) :: copy
181 :
182 9 : copy = den
183 :
184 907362 : den%mt(:,0:,:, 1) = copy%mt(:,0:,:, 1) + copy%mt(:,0:,:, 2)
185 907362 : den%mt(:,0:,:, 2) = copy%mt(:,0:,:, 1) - copy%mt(:,0:,:, 2)
186 22272 : den%pw(:, 1) = copy%pw(:, 1) + copy%pw(:, 2)
187 22272 : den%pw(:, 2) = copy%pw(:, 1) - copy%pw(:, 2)
188 27 : den%vac(:,:,:,1) = copy%vac(:,:,:,1) + copy%vac(:,:,:,2)
189 27 : den%vac(:,:,:,2) = copy%vac(:,:,:,1) - copy%vac(:,:,:,2)
190 9 : end subroutine
191 :
192 9 : subroutine ChargeAndMagnetisationToSpins( den )
193 : implicit none
194 : class(t_potden), intent(inout) :: den
195 : !type(t_potden), intent(inout) :: spins
196 :
197 9 : type(t_potden) :: copy
198 :
199 9 : copy = den
200 :
201 907362 : den%mt(:,0:,:, 1) = ( copy%mt(:,0:,:, 1) + copy%mt(:,0:,:, 2) ) / 2
202 907362 : den%mt(:,0:,:, 2) = ( copy%mt(:,0:,:, 1) - copy%mt(:,0:,:, 2) ) / 2
203 22272 : den%pw(:, 1) = ( copy%pw(:, 1) + copy%pw(:, 2) ) / 2
204 22272 : den%pw(:, 2) = ( copy%pw(:, 1) - copy%pw(:, 2) ) / 2
205 27 : den%vac(:,:,:,1) = ( copy%vac(:,:,:,1) + copy%vac(:,:,:,2) ) / 2
206 27 : den%vac(:,:,:,2) = ( copy%vac(:,:,:,1) - copy%vac(:,:,:,2) ) / 2
207 9 : end subroutine
208 :
209 9 : subroutine addPotDen( PotDen3, PotDen1, PotDen2 )
210 : implicit none
211 : class(t_potden), intent(in) :: PotDen1
212 : class(t_potden), intent(in) :: PotDen2
213 : class(t_potden), intent(inout) :: PotDen3
214 :
215 9 : PotDen3%iter = PotDen1%iter
216 9 : PotDen3%potdenType = PotDen1%potdenType
217 :
218 : ! implicit allocation would break the bounds staring at 0
219 9 : if(.not. allocated(PotDen3%mt)) allocate(PotDen3%mt, mold=PotDen1%mt)
220 :
221 1077948 : PotDen3%mt = PotDen1%mt + PotDen2%mt
222 26130 : PotDen3%pw = PotDen1%pw + PotDen2%pw
223 54 : PotDen3%vac = PotDen1%vac + PotDen2%vac
224 9 : if( allocated( PotDen1%pw_w ) .and. allocated( PotDen2%pw_w ) .and. allocated( PotDen3%pw_w ) ) then
225 18444 : PotDen3%pw_w = PotDen1%pw_w + PotDen2%pw_w
226 : end if
227 :
228 9 : end subroutine
229 :
230 676 : subroutine subPotDen( PotDen3, PotDen1, PotDen2 )
231 : implicit none
232 : class(t_potden), intent(in) :: PotDen1
233 : class(t_potden), intent(in) :: PotDen2
234 : class(t_potden), intent(inout) :: PotDen3
235 :
236 676 : PotDen3%iter = PotDen1%iter
237 676 : PotDen3%potdenType = PotDen1%potdenType
238 :
239 : ! implicit allocation would break the bounds starting at 0
240 4026 : if(.not. allocated(PotDen3%mt)) allocate(PotDen3%mt, mold=PotDen1%mt)
241 :
242 : ! The following allocates are countermeasures to valgrind complaints
243 4026 : if(.not. allocated(PotDen3%vac)) allocate(PotDen3%vac, mold=PotDen1%vac)
244 :
245 46743414 : PotDen3%mt = PotDen1%mt - PotDen2%mt
246 3024442 : PotDen3%pw = PotDen1%pw - PotDen2%pw
247 19830128 : PotDen3%vac = PotDen1%vac - PotDen2%vac
248 676 : if( allocated( PotDen1%pw_w ) .and. allocated( PotDen2%pw_w ) .and. allocated( PotDen3%pw_w ) ) then
249 0 : PotDen3%pw_w = PotDen1%pw_w - PotDen2%pw_w
250 : end if
251 :
252 676 : end subroutine
253 :
254 706 : subroutine copyPotDen( PotDenCopy, PotDen )
255 :
256 : implicit none
257 : class(t_potden), intent(in) :: PotDen
258 : class(t_potden), intent(inout) :: PotDenCopy
259 :
260 706 : PotDenCopy%iter = PotDen%iter
261 706 : PotDenCopy%potdenType = PotDen%potdenType
262 :
263 : ! implicit allocation would break the bounds starting at 0
264 4131 : if(.not. allocated(PotDenCopy%mt)) allocate(PotDenCopy%mt, mold=PotDen%mt)
265 :
266 : ! The following allocates are countermeasures to valgrind complaints
267 4131 : if(.not. allocated(PotDenCopy%vac)) allocate(PotDenCopy%vac, mold=PotDen%vac)
268 :
269 58762828 : PotDenCopy%mt = PotDen%mt
270 3303998 : PotDenCopy%pw = PotDen%pw
271 19915762 : PotDenCopy%vac = PotDen%vac
272 7244 : PotDenCopy%qint = PotDen%qint
273 7244 : PotDenCopy%tec = PotDen%tec
274 1682364 : PotDenCopy%mtCore = PotDen%mtCore
275 87216 : PotDenCopy%mmpMat = PotDen%mmpMat
276 76956 : PotDenCopy%nIJ_llp_mmp= PotDen%nIJ_llp_mmp
277 :
278 706 : end subroutine copyPotDen
279 :
280 5251 : SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,noco,jspins,potden_type,l_dfpt)
281 : USE m_judft
282 : USE m_types_atoms
283 : USE m_types_stars
284 : USE m_types_vacuum
285 : USE m_types_noco
286 : USE m_types_sphhar
287 :
288 : IMPLICIT NONE
289 : CLASS(t_potden),INTENT(OUT):: pd
290 : TYPE(t_atoms),INTENT(IN) :: atoms
291 : TYPE(t_stars),INTENT(IN) :: stars
292 : TYPE(t_sphhar),INTENT(IN):: sphhar
293 : TYPE(t_vacuum),INTENT(IN):: vacuum
294 : TYPE(t_noco),INTENT(IN) :: noco
295 : INTEGER,INTENT(IN) :: jspins, potden_type
296 : LOGICAL, OPTIONAL, INTENT(IN) :: l_dfpt
297 :
298 : LOGICAL :: do_dfpt
299 :
300 5251 : do_dfpt = .FALSE.
301 5251 : IF (PRESENT(l_dfpt)) do_dfpt = l_dfpt
302 : CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,atoms%msh,sphhar%nlhd,atoms%ntype,&
303 : atoms%n_denmat,atoms%n_vPairs,jspins,noco%l_noco,noco%l_mperp,potden_type,&
304 5251 : vacuum%nmzd,vacuum%nmzxyd,stars%ng2,do_dfpt)
305 5251 : END SUBROUTINE init_potden_types
306 :
307 5985 : SUBROUTINE init_potden_simple(pd,ng3,jmtd,coreMsh,nlhd,ntype,n_u,n_vPairs,jspins,nocoExtraDim,nocoExtraMTDim,potden_type,nmzd,nmzxyd,n2d,do_dfpt)
308 : USE m_constants
309 : USE m_judft
310 : IMPLICIT NONE
311 : CLASS(t_potden),INTENT(OUT) :: pd
312 : INTEGER,INTENT(IN) :: ng3,jmtd,coreMsh,nlhd,ntype,n_u,n_vPairs,jspins,potden_type
313 : LOGICAL,INTENT(IN) :: nocoExtraDim,nocoExtraMTDim
314 : INTEGER,INTENT(IN) :: nmzd,nmzxyd,n2d
315 : LOGICAL,OPTIONAL,INTENT(IN) :: do_dfpt
316 :
317 : INTEGER:: err(3)
318 : LOGICAL :: l_dfpt
319 :
320 5985 : l_dfpt = .FALSE.
321 5985 : IF (PRESENT(do_dfpt)) l_dfpt = do_dfpt
322 :
323 5985 : err=0
324 5985 : pd%iter=0
325 5985 : pd%potdenType=potden_type
326 5985 : IF(ALLOCATED(pd%pw)) DEALLOCATE (pd%pw)
327 5985 : IF(ALLOCATED(pd%mt)) DEALLOCATE (pd%mt)
328 5985 : IF(ALLOCATED(pd%vac)) DEALLOCATE (pd%vac)
329 5985 : IF(ALLOCATED(pd%qint)) DEALLOCATE (pd%qint)
330 5985 : IF(ALLOCATED(pd%tec)) DEALLOCATE (pd%tec)
331 5985 : IF(ALLOCATED(pd%mtCore)) DEALLOCATE (pd%mtCore)
332 5985 : IF(ALLOCATED(pd%mmpMat)) DEALLOCATE (pd%mmpMat)
333 5985 : IF(ALLOCATED(pd%nIJ_llp_mmp)) DEALLOCATE (pd%nIJ_llp_mmp)
334 :
335 5985 : IF (l_dfpt) THEN
336 0 : ALLOCATE (pd%pw(ng3,MERGE(4,jspins,nocoExtraDim)),stat=err(1))
337 : ELSE
338 23940 : ALLOCATE (pd%pw(ng3,MERGE(3,jspins,nocoExtraDim)),stat=err(1))
339 : END IF
340 35910 : ALLOCATE (pd%mt(jmtd,0:nlhd,ntype,MERGE(4,jspins,nocoExtraMTDim)),stat=err(2))
341 35910 : ALLOCATE (pd%vac(nmzd,n2d,2,MERGE(3,jspins,nocoExtraDim)),stat=err(3))
342 23940 : ALLOCATE (pd%qint(ntype,jspins))
343 17955 : ALLOCATE (pd%tec(ntype,jspins))
344 29925 : ALLOCATE (pd%mtCore(coreMsh,ntype,jspins))
345 :
346 29311 : ALLOCATE (pd%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,n_u),MERGE(3,jspins,nocoExtraMTDim)))
347 23940 : ALLOCATE (pd%nIJ_llp_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,n_vPairs),MERGE(3,jspins,nocoExtraMTDim)))
348 :
349 23940 : IF (ANY(err>0)) CALL judft_error("Not enough memory allocating potential or density")
350 32737923 : pd%pw=CMPLX(0.0,0.0)
351 486423695 : pd%mt=0.0
352 139090075 : pd%vac=CMPLX(0.0,0.0)
353 30667 : pd%qint = 0.0
354 30667 : pd%tec = 0.0
355 13274553 : pd%mtCore = 0.0
356 647423 : pd%mmpMat = CMPLX(0.0,0.0)
357 578909 : pd%nIJ_llp_mmp = CMPLX(0.0,0.0)
358 5985 : END SUBROUTINE init_potden_simple
359 : !!$#CPP_TODO_copy !code from brysh1,brysh2...
360 : !!$ SUBROUTINE get_combined_vector(input,stars,atoms,sphhar,noco,vacuum,sym ,&
361 : !!$ den,nmap,nmaph,mapmt,mapvac2,sout)
362 : !!$ !This was brysh1 before
363 : !!$ USE m_types
364 : !!$ IMPLICIT NONE
365 : !!$
366 : !!$ TYPE(t_input),INTENT(IN) :: input
367 : !!$ TYPE(t_vacuum),INTENT(IN) :: vacuum
368 : !!$ TYPE(t_noco),INTENT(IN) :: noco
369 : !!$ TYPE(t_sym),INTENT(IN) :: sym
370 : !!$ TYPE(t_stars),INTENT(IN) :: stars
371 : !!$ TYPE(t_sphhar),INTENT(IN) :: sphhar
372 : !!$ TYPE(t_atoms),INTENT(IN) :: atoms
373 : !!$ TYPE(t_potden),INTENT(IN) :: den
374 : !!$
375 : !!$ ! Scalar Arguments
376 : !!$ INTEGER, INTENT (OUT) :: mapmt,mapvac2,nmap,nmaph
377 : !!$
378 : !!$ ! Array Arguments
379 : !!$ REAL,ALLOCATABLE,INTENT (OUT) :: sout(:)
380 : !!$
381 : !!$ ! Local Scalars
382 : !!$ INTEGER i,iv,j,js,k,l,n,na,nvaccoeff,nvaccoeff2,mapmtd
383 : !!$
384 : !!$ !Calculation of size
385 : !!$ i=SIZE(den%mt)+MERGE(SIZE(den%pw),2*SIZE(den%pw),sym%invs)+SIZE(den%vacxz)+MERGE(SIZE(den%vacz)*2,SIZE(den%vacz),sym%invs)
386 : !!$ IF (any(noco%l_unrestrictMT).AND.sym%invs) i=i+
387 : !!$
388 : !!$
389 : !!$
390 : !!$ !---> put input into arrays sout
391 : !!$ ! in the spin polarized case the arrays consist of
392 : !!$ ! spin up and spin down densities
393 : !!$
394 : !!$ j=0
395 : !!$ DO js = 1,input%jspins
396 : !!$ DO i = 1,stars%ng3
397 : !!$ j = j + 1
398 : !!$ sout(j) = REAL(den%pw(i,js))
399 : !!$ END DO
400 : !!$ IF (.NOT.sym%invs) THEN
401 : !!$ DO i = 1,stars%ng3
402 : !!$ j = j + 1
403 : !!$ sout(j) = AIMAG(den%pw(i,js))
404 : !!$ END DO
405 : !!$ ENDIF
406 : !!$ mapmt=0
407 : !!$ na = 1
408 : !!$ DO n = 1,atoms%ntype
409 : !!$ DO l = 0,sphhar%nlh(sym%ntypsy(na))
410 : !!$ DO i = 1,atoms%jri(n)
411 : !!$ mapmt = mapmt +1
412 : !!$ j = j + 1
413 : !!$ sout(j) = den%mt(i,l,n,js)
414 : !!$ END DO
415 : !!$ END DO
416 : !!$ na = na + atoms%neq(n)
417 : !!$ END DO
418 : !!$ IF (input%film) THEN
419 : !!$ DO iv = 1,vacuum%nvac
420 : !!$ DO k = 1,vacuum%nmz
421 : !!$ j = j + 1
422 : !!$ sout(j) = den%vacz(k,iv,js)
423 : !!$ END DO
424 : !!$ DO k = 1,stars%ng2-1
425 : !!$ DO i = 1,vacuum%nmzxy
426 : !!$ j = j + 1
427 : !!$ sout(j) = REAL(den%vacxy(i,k,iv,js))
428 : !!$ END DO
429 : !!$ END DO
430 : !!$ IF (.NOT.sym%invs2) THEN
431 : !!$ DO k = 1,stars%ng2-1
432 : !!$ DO i = 1,vacuum%nmzxy
433 : !!$ j = j + 1
434 : !!$ sout(j) = AIMAG(den%vacxy(i,k,iv,js))
435 : !!$ END DO
436 : !!$ END DO
437 : !!$ END IF
438 : !!$ END DO
439 : !!$ END IF
440 : !!$ IF (js .EQ. 1) nmaph = j
441 : !!$ ENDDO
442 : !!$
443 : !!$ mapvac2=0
444 : !!$ IF (noco%l_noco) THEN
445 : !!$ !---> off-diagonal part of the density matrix
446 : !!$ DO i = 1,stars%ng3
447 : !!$ j = j + 1
448 : !!$ sout(j) = REAL(den%pw(i,3))
449 : !!$ END DO
450 : !!$ DO i = 1,stars%ng3
451 : !!$ j = j + 1
452 : !!$ sout(j) = AIMAG(den%pw(i,3))
453 : !!$ END DO
454 : !!$ IF (input%film) THEN
455 : !!$ DO iv = 1,vacuum%nvac
456 : !!$ DO k = 1,vacuum%nmz
457 : !!$ mapvac2 = mapvac2 + 1
458 : !!$ j = j + 1
459 : !!$ sout(j) = den%vacz(k,iv,3)
460 : !!$ END DO
461 : !!$ DO k = 1,stars%ng2-1
462 : !!$ DO i = 1,vacuum%nmzxy
463 : !!$ mapvac2 = mapvac2 + 1
464 : !!$ j = j + 1
465 : !!$ sout(j) = REAL(den%vacxy(i,k,iv,3))
466 : !!$ END DO
467 : !!$ END DO
468 : !!$ END DO
469 : !!$ DO iv = 1,vacuum%nvac
470 : !!$ DO k = 1,vacuum%nmz
471 : !!$ mapvac2 = mapvac2 + 1
472 : !!$ j = j + 1
473 : !!$ sout(j) = den%vacz(k,iv,4)
474 : !!$ END DO
475 : !!$ DO k = 1,stars%ng2-1
476 : !!$ DO i = 1,vacuum%nmzxy
477 : !!$ mapvac2 = mapvac2 + 1
478 : !!$ j = j + 1
479 : !!$ sout(j) = AIMAG(den%vacxy(i,k,iv,3))
480 : !!$ END DO
481 : !!$ END DO
482 : !!$ END DO
483 : !!$ nvaccoeff2 = 2*vacuum%nmzxy*(stars%ng2-1)*vacuum%nvac + 2*vacuum%nmz*vacuum%nvac
484 : !!$ IF (mapvac2 .NE. nvaccoeff2) THEN
485 : !!$ WRITE (oUnit,*)'The number of vaccum coefficients off the'
486 : !!$ WRITE (oUnit,*)'off-diagonal part of the density matrix is'
487 : !!$ WRITE (oUnit,*)'inconsitent:'
488 : !!$ WRITE (oUnit,8000) mapvac2,nvaccoeff2
489 : !!$8000 FORMAT ('mapvac2= ',i12,'nvaccoeff2= ',i12)
490 : !!$ CALL juDFT_error("brysh1:# of vacuum coeff. inconsistent" ,calledby ="brysh1")
491 : !!$ ENDIF
492 : !!$ END IF
493 : !!$ ENDIF ! noco
494 : !!$
495 : !!$ IF (atoms%n_u > 0 ) THEN ! lda+U
496 : !!$ DO js = 1,input%jspins
497 : !!$ DO n = 1, atoms%n_u
498 : !!$ DO k = -3, 3
499 : !!$ DO i = -3, 3
500 : !!$ j = j + 1
501 : !!$ sout(j) = REAL(den%mmpMat(i,k,n,js))
502 : !!$ j = j + 1
503 : !!$ sout(j) = AIMAG(den%mmpMat(i,k,n,js))
504 : !!$ ENDDO
505 : !!$ ENDDO
506 : !!$ ENDDO
507 : !!$ ENDDO
508 : !!$ ENDIF
509 : !!$
510 : !!$ mapmtd = atoms%ntype*(sphhar%nlhd+1)*atoms%jmtd
511 : !!$ IF (mapmt .GT. mapmtd) THEN
512 : !!$ WRITE(oUnit,*)'The number of mt coefficients is larger than the'
513 : !!$ WRITE(oUnit,*)'dimensions:'
514 : !!$ WRITE (oUnit,8040) mapmt,mapmtd
515 : !!$8040 FORMAT ('mapmt= ',i12,' > mapmtd= ',i12)
516 : !!$ CALL juDFT_error("brysh1: mapmt > mapmtd (dimensions)",calledby ="brysh1")
517 : !!$ ENDIF
518 : !!$
519 : !!$ nmap = j
520 : !!$ IF (nmap.GT.SIZE(sout)) THEN
521 : !!$ WRITE(oUnit,*)'The total number of charge density coefficients is'
522 : !!$ WRITE(oUnit,*)'larger than the dimensions:'
523 : !!$ WRITE (oUnit,8030) nmap,SIZE(sout)
524 : !!$8030 FORMAT ('nmap= ',i12,' > size(sout)= ',i12)
525 : !!$ CALL juDFT_error("brysh1: nmap > mmap (dimensions)",calledby ="brysh1")
526 : !!$ ENDIF
527 : !!$
528 : !!$ END SUBROUTINE get_combined_vector
529 : !!$#endif
530 :
531 :
532 :
533 3440 : SUBROUTINE resetPotDen(pd)
534 :
535 : IMPLICIT NONE
536 :
537 : CLASS(t_potden),INTENT(INOUT) :: pd
538 :
539 15261796 : pd%pw=CMPLX(0.0,0.0)
540 231234178 : pd%mt=0.0
541 98240468 : pd%vac=CMPLX(0.0,0.0)
542 17542 : pd%qint = 0.0
543 17542 : pd%tec = 0.0
544 7659500 : pd%mtCore = 0.0
545 368332 : pd%mmpMat = CMPLX(0.0,0.0)
546 319540 : pd%nIJ_llp_mmp = CMPLX(0.0,0.0)
547 3440 : IF (ALLOCATED(pd%pw_w)) DEALLOCATE(pd%pw_w)
548 3440 : END SUBROUTINE resetPotDen
549 :
550 0 : SUBROUTINE reset_dfpt(pd)
551 :
552 : IMPLICIT NONE
553 :
554 : CLASS(t_potden),INTENT(INOUT) :: pd
555 :
556 0 : IF (ALLOCATED(pd%mt)) DEALLOCATE(pd%mt)
557 0 : IF (ALLOCATED(pd%pw)) DEALLOCATE(pd%pw)
558 0 : IF (ALLOCATED(pd%pw_w)) DEALLOCATE(pd%pw_w)
559 0 : END SUBROUTINE reset_dfpt
560 :
561 33708 : END MODULE m_types_potden
|