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_cdnval
8 :
9 : USE m_juDFT
10 : #ifdef CPP_MPI
11 : use mpi
12 : #endif
13 :
14 : CONTAINS
15 :
16 1018 : SUBROUTINE cdnval(eig_id, fmpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,enpara,stars,&
17 : vacuum,sphhar,sym,vTot ,cdnvalJob,den,regCharges,dos,vacdos,results,&
18 : moments,gfinp,hub1inp,hub1data,coreSpecInput,mcd,slab,orbcomp,jDOS,greensfImagPart)
19 :
20 : !************************************************************************************
21 : ! This is the FLEUR valence density generator
22 : !******** ABBREVIATIONS *************************************************************
23 : ! noccbd : number of occupied bands
24 : ! pallst : if set to .true. bands above the Fermi-Energy are taken into account
25 : ! ener : band energy averaged over all bands and k-points,
26 : ! wheighted with the l-like charge of each atom type
27 : ! sqal : l-like charge of each atom type. sum over all k-points and bands
28 : !************************************************************************************
29 :
30 : USE m_types
31 : USE m_constants
32 : USE m_eig66_io
33 : USE m_genMTBasis
34 : USE m_calcDenCoeffs
35 : USE m_mcdinit
36 : USE m_sympsi
37 : USE m_eparas ! energy parameters and partial charges
38 : USE m_qal21 ! off-diagonal part of partial charges
39 : USE m_abcof
40 : USE m_nmat ! calculate density matrix for LDA + U
41 : USE m_nmat21
42 : USE m_vacden
43 : USE m_pwden
44 : USE m_forcea8
45 : USE m_force_sf ! Klueppelberg (force level 3)
46 : USE m_checkdopall
47 : USE m_greensfBZint
48 : USE m_greensfCalcImagPart
49 : USE m_local_hamiltonian
50 : USE m_greensfCalcScalarProducts
51 : USE m_cdnmt ! calculate the density and orbital moments etc.
52 : USE m_orbmom ! coeffd for orbital moments
53 : USE m_qmtsl ! These subroutines divide the input%film into banddos%layers
54 : USE m_qintsl ! (slabs) and intergate the DOS in these banddos%layers
55 : USE m_orbcomp ! calculate orbital composition (like p_x,p_y,p_z)
56 : USE m_jDOS
57 : USE m_corespec, only : l_cs ! calculation of core spectra (EELS)
58 : USE m_corespec_io, only : corespec_init
59 : USE m_corespec_eval, only : corespec_gaunt,corespec_rme,corespec_dos,corespec_ddscs
60 : USE m_xmlOutput
61 : USE m_types_dos
62 : USE m_types_mcd
63 : USE m_types_slab
64 : USE m_types_jDOS
65 : USE m_types_vacDOS
66 : USE m_types_orbcomp
67 : #ifdef CPP_MPI
68 : USE m_mpi_col_den ! collect density data from parallel nodes
69 : #endif
70 : USE m_dfpt_rhomt
71 : USE m_dfpt_rhonmt
72 : USE m_nIJmat
73 :
74 : IMPLICIT NONE
75 :
76 : TYPE(t_results), INTENT(INOUT) :: results
77 : TYPE(t_mpi), INTENT(IN) :: fmpi
78 :
79 : TYPE(t_enpara), INTENT(IN) :: enpara
80 : TYPE(t_banddos), INTENT(IN) :: banddos
81 : TYPE(t_input), INTENT(IN) :: input
82 : TYPE(t_vacuum), INTENT(IN) :: vacuum
83 : TYPE(t_noco), INTENT(IN) :: noco
84 : TYPE(t_nococonv), INTENT(IN) :: nococonv
85 : TYPE(t_sym), INTENT(IN) :: sym
86 : TYPE(t_stars), INTENT(IN) :: stars
87 : TYPE(t_cell), INTENT(IN) :: cell
88 : TYPE(t_kpts), INTENT(IN) :: kpts
89 : TYPE(t_sphhar), INTENT(IN) :: sphhar
90 : TYPE(t_atoms), INTENT(IN) :: atoms
91 : TYPE(t_gfinp), INTENT(IN) :: gfinp
92 : TYPE(t_hub1inp), INTENT(IN) :: hub1inp
93 : TYPE(t_potden), INTENT(IN) :: vTot
94 : TYPE(t_cdnvalJob), INTENT(IN) :: cdnvalJob
95 : TYPE(t_potden), INTENT(INOUT) :: den
96 : TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
97 : TYPE(t_dos), INTENT(INOUT) :: dos
98 : TYPE(t_vacdos), INTENT(INOUT) :: vacdos
99 : TYPE(t_moments), INTENT(INOUT) :: moments
100 : TYPE(t_hub1data), OPTIONAL, INTENT(INOUT) :: hub1data
101 : TYPE(t_coreSpecInput), OPTIONAL, INTENT(IN) :: coreSpecInput
102 : TYPE(t_mcd), OPTIONAL, INTENT(INOUT) :: mcd
103 : TYPE(t_slab), OPTIONAL, INTENT(INOUT) :: slab
104 : TYPE(t_orbcomp), OPTIONAL, INTENT(INOUT) :: orbcomp
105 : TYPE(t_jDOS), OPTIONAL, INTENT(INOUT) :: jDOS
106 : TYPE(t_greensfImagPart),OPTIONAL, INTENT(INOUT) :: greensfImagPart
107 :
108 : ! Scalar Arguments
109 : INTEGER, INTENT(IN) :: eig_id, jspin
110 :
111 : ! Local Scalars
112 : INTEGER :: ikpt,ikpt_i,jsp_start,jsp_end,ispin,jsp,max_length_k_list,nk
113 : INTEGER :: iErr,nbands,noccbd,iType
114 : INTEGER :: skip_t,skip_tt,nbasfcn
115 : LOGICAL :: l_real, l_corespec, l_empty
116 :
117 : ! Local Arrays
118 1018 : REAL, ALLOCATABLE :: we(:),eig(:)
119 : REAL :: bkpt(3)
120 1018 : INTEGER, ALLOCATABLE :: ev_list(:)
121 1018 : REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions
122 :
123 1018 : TYPE (t_lapw) :: lapw
124 1018 : TYPE (t_orb) :: orb
125 1018 : TYPE (t_denCoeffs) :: denCoeffs
126 1018 : TYPE (t_denCoeffsOffdiag) :: denCoeffsOffdiag
127 1018 : TYPE (t_force) :: force
128 1018 : TYPE (t_eigVecCoeffs) :: eigVecCoeffs
129 1018 : TYPE (t_usdus) :: usdus
130 1018 : TYPE (t_mat) :: zMat
131 1018 : TYPE (t_gVacMap) :: gVacMap
132 1018 : TYPE (t_tlmplm) :: tlmplm
133 1018 : TYPE (t_greensfBZintCoeffs):: greensfBZintCoeffs
134 1018 : TYPE(t_scalarGF), ALLOCATABLE :: scalarGF(:)
135 :
136 1018 : CALL timestart("cdnval")
137 :
138 1018 : call timestart("init")
139 1018 : l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco).AND.atoms%n_hia==0
140 :
141 : ! Klueppelberg (force level 3)
142 1018 : IF (input%l_f.AND.(input%f_level.GE.3)) THEN
143 2 : CALL init_sf(sym,cell,atoms)
144 : END IF
145 :
146 1018 : IF (noco%l_mperp.OR.banddos%l_jDOS) THEN
147 : ! when the off-diag. part of the density matrix, i.e. m_x and
148 : ! m_y, is calculated inside the muffin-tins (l_mperp = T), cdnval
149 : ! is called only once. therefore, several spin loops have been
150 : ! added. if l_mperp = F, these loops run only from jspin - jspin.
151 60 : jsp_start = 1
152 60 : jsp_end = 2
153 : ELSE
154 958 : jsp_start = jspin
155 958 : jsp_end = jspin
156 : END IF
157 :
158 : !Do we need to consider the unoccupied states
159 1018 : l_empty = banddos%dos.or.banddos%band
160 1018 : IF(gfinp%n>0 .AND. PRESENT(greensfImagPart)) THEN
161 160 : l_empty = l_empty.OR.greensfImagPart%l_calc
162 : ENDIF
163 :
164 5090 : ALLOCATE (f(atoms%jmtd,2,0:atoms%lmaxd,input%jspins)) ! Deallocation before mpi_col_den
165 4072 : ALLOCATE (g(atoms%jmtd,2,0:atoms%lmaxd,input%jspins))
166 5090 : ALLOCATE (flo(atoms%jmtd,2,atoms%nlod,input%jspins))
167 :
168 : ! Initializations
169 1018 : CALL usdus%init(atoms,input%jspins)
170 1018 : CALL denCoeffs%init(atoms,sphhar,jsp_start,jsp_end)
171 : ! The last entry in denCoeffsOffdiag%init is l_fmpl. It is meant as a switch to a plot of the full magnet.
172 : ! density without the atomic sphere approximation for the magnet. density.
173 2836 : CALL denCoeffsOffdiag%init(atoms,noco,sphhar,banddos%l_jDOS,any(noco%l_unrestrictMT).OR.noco%l_mperp)
174 1018 : CALL force%init1(input,atoms)
175 1018 : CALL orb%init(atoms,noco,jsp_start,jsp_end)
176 :
177 : !Greens function always considers the empty states
178 1018 : IF(gfinp%n>0 .AND. PRESENT(greensfImagPart)) THEN
179 80 : IF(greensfImagPart%l_calc) THEN
180 80 : CALL greensfBZintCoeffs%init(gfinp,atoms,noco,SIZE(cdnvalJob%ev_list))
181 : CALL greensfCalcScalarProducts(gfinp,atoms,input,enpara,noco,sphhar,vTot,fmpi,hub1data=hub1data,&
182 80 : scalarProducts=scalarGF)
183 : ENDIF
184 : ENDIF
185 :
186 :
187 1018 : IF (denCoeffsOffdiag%l_fmpl.AND.(.NOT.noco%l_mperp)) CALL juDFT_error("for fmpl set noco%l_mperp = T!" ,calledby ="cdnval")
188 1018 : IF (banddos%l_mcd.AND..NOT.PRESENT(mcd)) CALL juDFT_error("mcd is missing",calledby ="cdnval")
189 :
190 : ! calculation of core spectra (EELS) initializations -start-
191 1018 : l_coreSpec = .FALSE.
192 1018 : IF (PRESENT(coreSpecInput)) THEN
193 1018 : CALL corespec_init(input,atoms,coreSpecInput)
194 1018 : IF(l_cs.AND.(fmpi%isize.NE.1)) CALL juDFT_error('EELS + fmpi not implemented', calledby = 'cdnval')
195 1018 : IF(l_cs.AND.jspin.EQ.1) CALL corespec_gaunt()
196 1018 : l_coreSpec = l_cs
197 : END IF
198 : ! calculation of core spectra (EELS) initializations -end-
199 :
200 1018 : IF (fmpi%irank==0) THEN
201 509 : WRITE (oUnit,FMT=8000) jspin
202 1527 : CALL openXMLElementPoly('mtCharges',(/'spin'/),(/jspin/))
203 : END IF
204 : 8000 FORMAT (/,/,10x,'valence density: spin=',i2)
205 :
206 2812 : DO iType = 1, atoms%ntype
207 4840 : DO ispin = 1, input%jspins
208 : CALL genMTBasis(atoms,enpara,vTot,fmpi,iType,ispin,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin),&
209 4840 : hub1data=hub1data)
210 : END DO
211 1794 : IF (noco%l_mperp.OR.banddos%l_jDOS) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType)
212 1794 : IF (banddos%l_mcd) CALL mcd_init(atoms,banddos,input,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin)
213 1794 : IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,29,input%jspins,jspin,results%ef,&
214 1018 : atoms%msh,vTot%mt(:,0,:,:),f,g)
215 : END DO
216 1018 : DEALLOCATE (f,g,flo)
217 :
218 2812 : skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype))
219 1018 : IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt
220 :
221 1018 : jsp = MERGE(1,jspin,noco%l_noco)
222 1018 : call timestop("init")
223 :
224 1018 : max_length_k_list=size(cdnvalJob%k_list)
225 : #ifdef CPP_MPI
226 1018 : CALL MPI_ALLREDUCE(MPI_IN_PLACE,max_length_k_list,1,MPI_INTEGER,MPI_MAX,fmpi%mpi_comm,ierr)
227 : #endif
228 8664 : DO ikpt_i = 1,size(cdnvalJob%k_list)
229 7646 : ikpt=cdnvalJob%k_list(ikpt_i)
230 30584 : bkpt=kpts%bk(:,ikpt)
231 :
232 7646 : CALL lapw%init(input,noco,nococonv, kpts,atoms,sym,ikpt,cell, fmpi)
233 7646 : skip_t = skip_tt
234 115431 : ev_list=cdnvaljob%compact_ev_list(ikpt_i,l_empty)
235 7646 : noccbd = SIZE(ev_list)
236 115431 : we = cdnvalJob%weights(ev_list,ikpt)
237 115431 : eig = results%eig(ev_list,ikpt,jsp)
238 :
239 7646 : IF (cdnvalJob%l_evp) THEN
240 69523 : IF (minval(ev_list) > skip_tt) skip_t = 0
241 69523 : IF (maxval(ev_list) <= skip_tt) skip_t = noccbd
242 139046 : IF ((minval(ev_list) <= skip_tt).AND.(maxval(ev_list) > skip_tt)) skip_t = mod(skip_tt,noccbd)
243 : END IF
244 :
245 7646 : nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
246 7646 : CALL zMat%init(l_real,nbasfcn,noccbd)
247 7646 : CALL read_eig(eig_id,ikpt,jsp,list=ev_list,neig=nbands,zmat=zMat)
248 : #ifdef CPP_MPI
249 7646 : CALL MPI_BARRIER(fmpi%mpi_comm,iErr) ! Synchronizes the RMA operations
250 : #endif
251 :
252 7646 : IF (noccbd.LE.0) CYCLE ! Note: This jump has to be after the MPI_BARRIER is called
253 :
254 : ! valence density in the atomic spheres
255 8018 : CALL eigVecCoeffs%init(input,atoms,jspin,noccbd,noco%l_mperp.OR.banddos%l_jDOS)
256 :
257 15660 : DO ispin = jsp_start, jsp_end
258 8018 : IF (input%l_f) CALL force%init2(noccbd,input,atoms)
259 : CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,nococonv,ispin,&
260 : eigVecCoeffs%abcof(:,0:,0,:,ispin),eigVecCoeffs%abcof(:,0:,1,:,ispin),&
261 8018 : eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
262 :
263 8018 : IF (atoms%n_u+atoms%n_opc.GT.0) CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,eigVecCoeffs,den%mmpMat(:,:,:,ispin))
264 8018 : IF (atoms%n_v.GT.0) CALL nIJ_mat(input,atoms,noccbd,usdus,ispin,we,eigVecCoeffs,cell,kpts,ikpt,den%nIJ_llp_mmp(:,:,:,ispin),enpara,vTot)
265 8018 : IF (atoms%n_u.GT.0.AND.noco%l_mperp.AND.(ispin==jsp_end)) THEN
266 0 : call timestart("n_mat21")
267 0 : CALL n_mat21(atoms,sym,noccbd,we,denCoeffsOffdiag,eigVecCoeffs,den%mmpMat(:,:,:,3))
268 0 : call timestop("n_mat21")
269 :
270 : ENDIF
271 : ! perform Brillouin zone integration and summation over the
272 : ! bands in order to determine the energy parameters for each atom and angular momentum
273 8018 : call timestart("eparas")
274 : CALL eparas(ispin,atoms,banddos,noccbd,ev_list,fmpi,ikpt,noccbd,we,eig,&
275 8018 : skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,mcd)
276 :
277 8018 : call timestop("eparas")
278 8018 : IF (noco%l_mperp.AND.(ispin==jsp_end)) then
279 374 : call timestart("qal_21")
280 374 : CALL qal_21(atoms,banddos,input,noccbd,ev_list,nococonv,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
281 374 : call timestop("qal_21")
282 : endif
283 :
284 : ! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
285 8018 : IF (PRESENT(slab).and.banddos%l_slab) CALL q_mt_sl(ispin,atoms,sym,noccbd,ev_list,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
286 :
287 8018 : IF(banddos%l_orb) THEN
288 :
289 20 : IF (PRESENT(orbcomp)) CALL orb_comp(banddos,ispin,ikpt,noccbd,ev_list,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
290 : ENDIF
291 : !Decomposition into total angular momentum states
292 8018 : IF(banddos%dos.AND.banddos%l_jDOS) THEN
293 4 : IF(PRESENT(jDOS).AND.ispin==jsp_end) THEN
294 : CALL jDOS_comp(ikpt,noccbd,ev_list,we,atoms,banddos,input,usdus,&
295 2 : denCoeffsOffdiag,eigVecCoeffs,jDOS)
296 : ENDIF
297 : ENDIF
298 8018 : CALL dfpt_rhomt(atoms,we,we,noccbd,ispin,ispin,[0.0,0.0,0.0],.FALSE.,eigVecCoeffs,eigVecCoeffs,denCoeffs)
299 8018 : CALL dfpt_rhonmt(atoms,sphhar,we,we,noccbd,ispin,ispin,[0.0,0.0,0.0],.FALSE.,.TRUE.,sym,eigVecCoeffs,eigVecCoeffs,denCoeffs)
300 8018 : CALL dfpt_rhomtlo(atoms,noccbd,we,we,ispin,ispin,[0.0,0.0,0.0],.FALSE.,eigVecCoeffs,eigVecCoeffs,denCoeffs)
301 8018 : CALL dfpt_rhonmtlo(atoms,sphhar,sym,noccbd,we,we,eigVecCoeffs,eigVecCoeffs,denCoeffs,ispin,ispin,.FALSE.,[0.0,0.0,0.0])
302 :
303 8018 : IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
304 8018 : IF (input%l_f) THEN
305 62 : call local_ham(sphhar,atoms,sym,noco,nococonv,enpara,fmpi,vtot,vtot,den,input,hub1inp,hub1data,tlmplm,usdus,0.0)
306 : CALL force%addContribsA21A12(input,atoms,sym,cell ,enpara,&
307 62 : usdus,tlmplm,vtot,eigVecCoeffs,noccbd,ispin,eig,we,results,jsp_start,jspin,nbasfcn,zMat,lapw,sphhar,lapw%gvec(1,:,:),lapw%gvec(2,:,:),lapw%gvec(3,:,:),bkpt)
308 : ENDIF
309 8018 : IF(l_coreSpec) CALL corespec_dos(atoms,usdus,ispin,atoms%lmaxd*(atoms%lmaxd+2),kpts%nkpt,ikpt,input%neig,&
310 7642 : noccbd,results%ef,banddos%sig_dos,eig,we,eigVecCoeffs)
311 : END DO ! end loop over ispin
312 7642 : IF (noco%l_mperp) then
313 374 : call timestart("denCoeffsOffdiag%calcCoefficients")
314 374 : CALL dfpt_rhomt(atoms,we,we,noccbd,2,1,[0.0,0.0,0.0],.FALSE.,eigVecCoeffs,eigVecCoeffs,denCoeffs)
315 374 : CALL dfpt_rhonmt(atoms,sphhar,we,we,noccbd,2,1,[0.0,0.0,0.0],.FALSE.,.FALSE.,sym,eigVecCoeffs,eigVecCoeffs,denCoeffs)
316 374 : CALL dfpt_rhomtlo(atoms,noccbd,we,we,2,1,[0.0,0.0,0.0],.FALSE.,eigVecCoeffs,eigVecCoeffs,denCoeffs)
317 374 : CALL dfpt_rhonmtlo(atoms,sphhar,sym,noccbd,we,we,eigVecCoeffs,eigVecCoeffs,denCoeffs,2,1,.FALSE.,[0.0,0.0,0.0])
318 374 : call timestop("denCoeffsOffdiag%calcCoefficients")
319 : endif
320 :
321 7642 : IF(gfinp%n>0 .AND. PRESENT(greensfImagPart)) THEN
322 448 : IF(greensfImagPart%l_calc) THEN
323 1792 : do ispin = MERGE(1,jsp_start,gfinp%l_mperp),MERGE(3,jsp_end,gfinp%l_mperp)
324 : CALL greensfBZint(ikpt,noccbd,ispin,gfinp,sym,atoms,noco,nococonv,input,kpts,&
325 456 : scalarGF,eigVecCoeffs,greensfBZintCoeffs)
326 : CALL greensfCalcImagPart_single_kpt(ikpt,ikpt_i,ev_list,ispin,gfinp,atoms,input,kpts,noco,fmpi,&
327 904 : results,greensfBZintCoeffs,greensfImagPart)
328 : enddo
329 : ENDIF
330 : ENDIF
331 :
332 7642 : CALL gVacMap%init(sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)
333 :
334 : ! valence density in the interstitial and vacuum region has to be called only once (if jspin=1) in the non-collinear case
335 7642 : IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN
336 : ! valence density in the interstitial region
337 : CALL pwden(stars,kpts,banddos ,input,fmpi,noco,nococonv,cell,atoms,sym,ikpt,&
338 7322 : jspin,lapw,noccbd,ev_list,we,eig,den,results,force%f_b8,zMat,dos)
339 : ! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
340 7322 : IF (PRESENT(slab).AND.banddos%l_slab) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,ev_list,lapw,slab ,zMat)
341 : ! valence density in the vacuum region
342 7322 : IF (input%film) THEN
343 : CALL vacden(vacuum,stars,input,cell,atoms,noco,nococonv,banddos,&
344 106776 : we,ikpt,jspin,REAL(vTot%vac(:,1,:,:)),noccbd,ev_list,lapw,enpara%evac,den,zMat,vacdos,dos)
345 : END IF
346 : END IF
347 7642 : IF (input%film) CALL regCharges%sumBandsVac(vacuum,vacdos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
348 :
349 8664 : IF (.FALSE..AND.(banddos%dos.OR.banddos%vacdos.OR.input%cdinf)) THEN
350 : ! since z is no longer an argument of cdninf sympsi has to be called here!
351 : CALL sympsi(lapw,jspin,sym,noccbd,cell,eig,noco,dos%jsym(:,ikpt,jspin),zMat)
352 : END IF
353 : END DO ! end of k-point loop
354 :
355 : #ifdef CPP_MPI
356 : !print *,"Remaining Barriers:",size(cdnvalJob%k_list)+1,max_length_k_list
357 1018 : DO nk=size(cdnvalJob%k_list)+1,max_length_k_list
358 1018 : CALL MPI_BARRIER(fmpi%MPI_COMM,ierr)
359 : ENDDO
360 2096 : DO ispin = jsp_start,jsp_end
361 : CALL mpi_col_den(fmpi,sphhar,atoms ,stars,vacuum,input,noco,ispin,dos,vacdos,&
362 2096 : results,denCoeffs,orb,denCoeffsOffdiag,den,regCharges,mcd,slab,orbcomp,jDOS)
363 : END DO
364 : #endif
365 :
366 1018 : IF(gfinp%n>0 .AND. PRESENT(greensfImagPart)) THEN
367 80 : IF(greensfImagPart%l_calc) THEN
368 80 : call timestart("Green's function: Imag Part collect")
369 320 : do ispin = MERGE(1,jsp_start,gfinp%l_mperp),MERGE(3,jsp_end,gfinp%l_mperp)
370 168 : CALL greensfImagPart%collect(ispin,fmpi%mpi_comm)
371 : enddo
372 80 : call timestop("Green's function: Imag Part collect")
373 : ENDIF
374 : ENDIF
375 :
376 1018 : IF (fmpi%irank==0) THEN
377 509 : CALL timestart("cdnmt")
378 : CALL cdnmt(input%jspins,input,atoms,sym,sphhar,noco,jsp_start,jsp_end,enpara,banddos,&
379 1138354 : vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,den%mt,hub1inp,moments,jDOS,hub1data=hub1data)
380 509 : CALL timestop("cdnmt")
381 509 : IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
382 1048 : DO ispin = jsp_start,jsp_end
383 539 : IF (input%cdinf) THEN
384 0 : WRITE (oUnit,FMT=8210) ispin
385 : 8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2)
386 0 : CALL checkDOPAll(input,sphhar,stars,atoms,sym,vacuum ,cell,den,ispin)
387 : END IF
388 1048 : IF (input%l_f) CALL force_a8(input,atoms,sym,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,fmpi,results)
389 : END DO
390 509 : CALL closeXMLElement('mtCharges')
391 : END IF
392 :
393 1018 : CALL timestop("cdnval")
394 :
395 3046 : END SUBROUTINE cdnval
396 :
397 : END MODULE m_cdnval
|