TABLE OF CONTENTS
- ABINIT/m_pawdij
- m_pawdij/pawdij
- m_pawdij/pawdij_gather
- m_pawdij/pawdij_print_ij
- m_pawdij/pawdijexxc
- m_pawdij/pawdijfock
- m_pawdij/pawdijfr
- m_pawdij/pawdijhartree
- m_pawdij/pawdijhat
- m_pawdij/pawdijnd
- m_pawdij/pawdijso
- m_pawdij/pawdiju
- m_pawdij/pawdiju_euijkl
- m_pawdij/pawdijxc
- m_pawdij/pawdijxcm
- m_pawdij/pawpupot
- m_pawdij/pawxpot
- m_pawdij/symdij
- m_pawdij/symdij_all
ABINIT/m_pawdij [ Modules ]
NAME
m_pawdij
FUNCTION
This module contains several routines used to compute the PAW pseudopotential
strengths Dij. The Dijs define the non-local PAW operator:
VNL = Sum_ij [ Dij |pi><pj| ], with pi, pj= projectors
COPYRIGHT
Copyright (C) 2013-2018 ABINIT group (MT, FJ, BA, JWZ) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt . For the initials of contributors, see ~abinit/doc/developers/contributors.txt.
NOTES
FOR DEVELOPPERS: in order to preserve the portability of libPAW library, please consult ~abinit/src/??_libpaw/libpaw-coding-rules.txt
SOURCE
24 #include "libpaw.h" 25 26 MODULE m_pawdij 27 28 USE_DEFS 29 USE_MSG_HANDLING 30 USE_MPI_WRAPPERS 31 USE_MEMORY_PROFILING 32 33 use m_paral_atom, only : get_my_atmtab, free_my_atmtab 34 use m_paw_io, only : pawio_print_ij 35 use m_pawang, only : pawang_type 36 use m_pawrad, only : pawrad_type, pawrad_deducer0, simp_gen, nderiv_gen 37 use m_pawtab, only : pawtab_type 38 use m_paw_an, only : paw_an_type 39 use m_paw_ij, only : paw_ij_type, paw_ij_print 40 use m_pawfgrtab, only : pawfgrtab_type 41 use m_pawrhoij, only : pawrhoij_type 42 use m_paw_finegrid, only : pawgylm, pawexpiqr 43 use m_paw_sphharm, only : slxyzs 44 45 implicit none 46 47 private 48 49 !public procedures. 50 public :: pawdij ! Dij total 51 public :: pawdijfock ! Dij Fock exact-exchange 52 public :: pawdijhartree ! Dij Hartree 53 public :: pawdijxc ! Dij eXchange-Correlation (using (r,theta,phi) grid) 54 public :: pawdijxcm ! Dij eXchange-Correlation (using (l,m) moments) 55 public :: pawdijhat ! Dij^hat (compensation charge contribution) 56 public :: pawdijnd ! Dij nuclear dipole 57 public :: pawdijso ! Dij spin-orbit 58 public :: pawdiju ! Dij LDA+U 59 public :: pawdiju_euijkl ! Dij LDA+U, using pawrhoij instead of occupancies 60 public :: pawdijexxc ! Dij local exact-exchange 61 public :: pawdijfr ! 1st-order frozen Dij 62 public :: pawpupot ! On-site LDA+U potential 63 public :: pawxpot ! On-site local exact-exchange potential 64 public :: symdij ! Symmetrize total Dij or one part of it 65 public :: symdij_all ! Symmetrize all contributions to Dij 66 public :: pawdij_gather ! Perform a allgather operation on Dij 67 public :: pawdij_print_dij ! Print out a Dij matrix
m_pawdij/pawdij [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdij
FUNCTION
Compute the pseudopotential strengths Dij of the PAW non local operator as sum of several contributions. Can compute first-order strenghts Dij for RF calculations. This routine is a driver calling, for each contribution to Dij, a specific routines. Within standard PAW formalism, Dij can be decomposd as follows: Dij = Dij_atomic + Dij_Hartree + Dij_XC + Dij^hat In case of additional approximations, several other terms can appear: Dij_LDA+U, Dij_spin-orbit, Dij_local-exact-exchange, Dij_Fock...
INPUTS
cplex=1 if no phase is applied (GS), 2 if a exp(-iqr) phase is applied (Response Function at q<>0) enunit=choice for units of output Dij gprimd(3,3)=dimensional primitive translations for reciprocal space [hyb_mixing, hyb_mixing_sr]= -- optional-- mixing factors for the global (resp. screened) XC hybrid functional ipert=index of perturbation (used only for RF calculation ; set ipert<=0 for GS calculations. my_natom=number of atoms treated by current processor natom=total number of atoms in cell nfft=number of real space grid points (for current proc) nfftot=total number of real space grid points nspden=number of spin-density components ntypat=number of types of atoms in unit cell. paw_an(my_natom) <type(paw_an_type)>=paw arrays given on angular mesh paw_ij(my_natom) <type(paw_ij_type)>=paw arrays given on (i,j) channels pawang <type(pawang_type)>=paw angular mesh and related data pawfgrtab(my_natom) <type(pawfgrtab_type)>=atomic data given on fine rectangular grid pawprtvol=control print volume and debugging output for PAW pawrad(ntypat) <type(pawrad_type)>=paw radial mesh and related data pawrhoij(my_natom) <type(pawrhoij_type)>= paw rhoij occupancies and related data pawspnorb=flag: 1 if spin-orbit coupling is activated pawtab(ntypat) <type(pawtab_type)>=paw tabulated starting data pawxcdev=Choice of XC development (0=no dev. (use of angular mesh) ; 1 or 2=dev. on moments) qphon(3)=wavevector of the phonon spnorbscl=scaling factor for spin-orbit coupling ucvol=unit cell volume vtrial(cplex*nfft,nspden)=GS potential on real space grid vxc(cplex*nfft,nspden)=XC potential (Hartree) on real space grid xred(3,my_natom)= reduced atomic coordinates ======== Optional arguments ============== Parallelism over atomic sites: mpi_atmtab(:)=indexes of the atoms treated by current proc comm_atom=MPI communicator over atoms mpi_comm_grid=MPI communicator over real space grid points Application of a potential energy shift on atomic sites: natvshift=number of atomic potential energy shifts (per atom) ; default=0 atvshift(natvshift,nsppol,natom)=potential energy shift for lm channel & spin & atom fatvshift=factor that multiplies atvshift Electrons-positron 2-component DFT: electronpositron_calctype=type of calculation for electron-positron 2component-DFT: 0: standard DFT (no positron) ; default value 1: positron in the constant electrons potential 2: electrons in the constant positron potential electronpositron_pawrhoij(my_natom) <type(pawrhoij_type)>= PAW occupation matrix of the "constant" particle(s) (electrons if calctype=1, positron if calctype=2) electronpositron_lmselect(lmmax,my_natom)= Flags selecting the non-zero LM-moments of on-site densities for the "constant" particle(s) (electrons if calctype=1, positron if calctype=2)
OUTPUT
paw_ij(iatom)%dij(cplex_rf*cplex_dij*lmn2_size,ndij)= total Dij terms (GS calculation, ipert=0)
total 1st-order Dij terms (RF ccalc., ipert>0)
May be complex if cplex_dij=2
dij(:,1) contains Dij^up-up
dij(:,2) contains Dij^dn-dn
dij(:,3) contains Dij^up-dn (only if nspinor=2)
dij(:,4) contains Dij^dn-up (only if nspinor=2)
May also compute paw_ij(iatom)%dij0,paw_ij(iatom)%dijhartree,paw_ij(iatom)%dijxc,
paw_ij(iatom)%dijxc_hat,paw_ij(iatom)%dijxc_val,
paw_ij(iatom)%dijhat,paw_ij(iatom)dijso,
paw_ij(iatom)%dijU,paw_ij(iatom)%dijexxc,paw_ij(iatom)%dijfock
NOTES
Response function calculations:
In order to compute first-order Dij, paw_an (resp. paw_ij) datastructures
must contain first-order quantities, namely paw_an1 (resp. paw_ij1).
PARENTS
bethe_salpeter,dfpt_scfcv,respfn,scfcv,screening,sigma
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
167 subroutine pawdij(cplex,enunit,gprimd,ipert,my_natom,natom,nfft,nfftot,nspden,ntypat,& 168 & paw_an,paw_ij,pawang,pawfgrtab,pawprtvol,pawrad,pawrhoij,pawspnorb,pawtab,& 169 & pawxcdev,qphon,spnorbscl,ucvol,charge,vtrial,vxc,xred,& 170 & electronpositron_calctype,electronpositron_pawrhoij,electronpositron_lmselect,& 171 & atvshift,fatvshift,natvshift,nucdipmom,& 172 & mpi_atmtab,comm_atom,mpi_comm_grid,hyb_mixing,hyb_mixing_sr) 173 174 175 !This section has been created automatically by the script Abilint (TD). 176 !Do not modify the following lines by hand. 177 #undef ABI_FUNC 178 #define ABI_FUNC 'pawdij' 179 !End of the abilint section 180 181 implicit none 182 183 !Arguments --------------------------------------------- 184 !scalars 185 integer,intent(in) :: cplex,enunit,ipert,my_natom,natom,nfft,nfftot 186 integer,intent(in) :: nspden,ntypat,pawprtvol,pawspnorb,pawxcdev 187 integer,optional,intent(in) :: electronpositron_calctype 188 integer,optional,intent(in) :: comm_atom,mpi_comm_grid,natvshift 189 real(dp),intent(in) :: spnorbscl,ucvol,charge 190 real(dp),intent(in),optional ::fatvshift,hyb_mixing,hyb_mixing_sr 191 type(pawang_type),intent(in) :: pawang 192 !arrays 193 integer,optional,target,intent(in) :: mpi_atmtab(:) 194 logical,optional,intent(in) :: electronpositron_lmselect(:,:) 195 real(dp),intent(in) :: gprimd(3,3),qphon(3) 196 real(dp),intent(in) :: vxc(:,:),xred(3,natom) 197 real(dp),intent(in),target :: vtrial(cplex*nfft,nspden) 198 real(dp),intent(in),optional :: atvshift(:,:,:) 199 real(dp),intent(in),optional :: nucdipmom(3,my_natom) 200 type(paw_an_type),intent(in) :: paw_an(my_natom) 201 type(paw_ij_type),target,intent(inout) :: paw_ij(my_natom) 202 type(pawfgrtab_type),intent(inout) :: pawfgrtab(my_natom) 203 type(pawrad_type),intent(in) :: pawrad(ntypat) 204 type(pawrhoij_type),intent(inout) :: pawrhoij(my_natom) 205 type(pawrhoij_type),intent(in),optional :: electronpositron_pawrhoij(:) 206 type(pawtab_type),intent(in) :: pawtab(ntypat) 207 208 !Local variables --------------------------------------- 209 !scalars 210 integer :: cplex_dij,cplex_rf,iatom,iatom_tot,idij,ipositron,itypat,klmn,klmn1,lm_size,lmn2_size 211 integer :: lpawu,my_comm_atom,my_comm_grid,natvshift_,ndij,nsploop,nsppol,usexcnhat 212 logical :: dij_available,dij_need,dij_prereq 213 logical :: dij0_available,dij0_need,dij0_prereq 214 logical :: dijexxc_available,dijexxc_need,dijexxc_prereq 215 logical :: dijfock_available,dijfock_need,dijfock_prereq 216 logical :: dijhartree_available,dijhartree_need,dijhartree_prereq 217 logical :: dijhat_available,dijhat_need,dijhat_prereq 218 logical :: dijhatfr_available,dijhatfr_need,dijhatfr_prereq 219 logical :: dijnd_available,dijnd_need,dijnd_prereq 220 logical :: dijso_available,dijso_need,dijso_prereq 221 logical :: dijxc_available,dijxc_need,dijxc_prereq 222 logical :: dijxchat_available,dijxchat_need,dijxchat_prereq 223 logical :: dijxcval_available,dijxcval_need,dijxcval_prereq 224 logical :: dijU_available,dijU_need,dijU_prereq 225 logical :: has_nucdipmom,my_atmtab_allocated 226 logical :: need_to_print,paral_atom,pawu_new_algo,v_dijhat_allocated 227 real(dp) :: hyb_mixing_,hyb_mixing_sr_ 228 character(len=500) :: msg 229 !arrays 230 integer,pointer :: my_atmtab(:) 231 logical,allocatable :: lmselect(:) 232 real(dp),allocatable :: dij0(:),dijhartree(:) 233 real(dp),allocatable :: dijhat(:,:),dijexxc(:,:),dijfock_cv(:,:),dijfock_vv(:,:),dijpawu(:,:) 234 real(dp),allocatable :: dijnd(:,:),dijso(:,:),dijxc(:,:),dij_ep(:),dijxchat(:,:),dijxcval(:,:) 235 real(dp),pointer :: v_dijhat(:,:),vpawu(:,:,:,:),vpawx(:,:,:) 236 237 ! ************************************************************************* 238 239 !------------------------------------------------------------------------ 240 !----- Check consistency of arguments 241 !------------------------------------------------------------------------ 242 243 ! === Check optional arguments === 244 245 hyb_mixing_ =zero ; if(present(hyb_mixing)) hyb_mixing_ =hyb_mixing 246 hyb_mixing_sr_=zero ; if(present(hyb_mixing_sr)) hyb_mixing_sr_=hyb_mixing_sr 247 248 natvshift_=0;if (present(natvshift)) natvshift_=natvshift 249 if (natvshift_>0) then 250 if ((.not.present(atvshift)).or.(.not.present(fatvshift))) then 251 msg='when natvshift>0, atvshift and fatvshift arguments must be present!' 252 MSG_BUG(msg) 253 end if 254 end if 255 256 ipositron=0;if (present(electronpositron_calctype)) ipositron=electronpositron_calctype 257 if (ipositron/=0) then 258 if ((.not.present(electronpositron_pawrhoij)).or.& 259 & (.not.present(electronpositron_lmselect))) then 260 msg='ep_pawrhoij and ep_lmselect must be present for electron-positron calculations!' 261 MSG_BUG(msg) 262 end if 263 end if 264 265 has_nucdipmom=present(nucdipmom) 266 267 ! === Check complex character of arguments === 268 269 if (nspden==4.and.cplex==2) then 270 msg='nspden=4 probably not compatible with cplex=2!' 271 MSG_BUG(msg) 272 end if 273 if (my_natom>0) then 274 if (paw_ij(1)%ndij==4.and.paw_ij(1)%cplex_dij/=2) then 275 msg='invalid cplex size for Dij (4 Dij components)!' 276 MSG_BUG(msg) 277 end if 278 if (paw_ij(1)%cplex_rf/=paw_an(1)%cplex) then 279 msg='paw_ij()%cplex_rf and paw_an()%cplex must be equal!' 280 MSG_BUG(msg) 281 end if 282 if (ipert<=0.and.paw_ij(1)%cplex_rf/=1) then 283 msg='cplex must be 1 for GS calculations!' 284 MSG_BUG(msg) 285 end if 286 if (paw_ij(1)%cplex_rf/=cplex) then 287 msg='paw_ij()%cplex must be equal to cplex!' 288 MSG_BUG(msg) 289 end if 290 end if 291 292 !------------------------------------------------------------------------ 293 !----- Initializations 294 !------------------------------------------------------------------------ 295 296 !Nothing to do for some perturbations (RF case) 297 if (ipert==natom+1.or.ipert==natom+10) then 298 do iatom=1,my_natom 299 if (paw_ij(iatom)%has_dij==1) paw_ij(iatom)%dij=zero 300 if (paw_ij(iatom)%has_dij0==1) paw_ij(iatom)%dij0=zero 301 if (paw_ij(iatom)%has_dijfock==1) paw_ij(iatom)%dijfock=zero 302 if (paw_ij(iatom)%has_dijhartree==1) paw_ij(iatom)%dijhartree=zero 303 if (paw_ij(iatom)%has_dijxc==1) paw_ij(iatom)%dijxc=zero 304 if (paw_ij(iatom)%has_dijhat==1) paw_ij(iatom)%dijhat=zero 305 if (paw_ij(iatom)%has_dijso==1) paw_ij(iatom)%dijso=zero 306 if (paw_ij(iatom)%has_dijU==1) paw_ij(iatom)%dijU=zero 307 if (paw_ij(iatom)%has_dijexxc==1) paw_ij(iatom)%dijexxc=zero 308 if (paw_ij(iatom)%has_dijxc_hat==1) paw_ij(iatom)%dijxc_hat=zero 309 if (paw_ij(iatom)%has_dijxc_val==1) paw_ij(iatom)%dijxc_val=zero 310 end do 311 return 312 end if 313 314 !Set up parallelism over atoms 315 paral_atom=(present(comm_atom).and.(my_natom/=natom)) 316 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 317 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 318 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom) 319 320 !----- Various initializations 321 nsppol=1;nsploop=1 322 if (my_natom>0) then 323 nsppol=paw_ij(1)%nsppol 324 nsploop=nsppol;if (paw_ij(1)%ndij==4) nsploop=4 325 end if 326 usexcnhat=maxval(pawtab(1:ntypat)%usexcnhat) 327 my_comm_grid=xmpi_comm_self;if (present(mpi_comm_grid)) my_comm_grid=mpi_comm_grid 328 329 !------ Select potential for Dij^hat computation 330 v_dijhat_allocated=.false. 331 if (my_natom>0) then 332 if ((paw_ij(1)%has_dij==1).or.(paw_ij(1)%has_dijhat==1).or. & 333 & (paw_ij(1)%has_dijhat==0.and.pawprtvol/=0)) then 334 if (usexcnhat==0) then 335 if (size(vxc,1)/=cplex*nfft.or.size(vxc,2)/=nspden) then 336 msg='invalid size for vxc!' 337 MSG_BUG(msg) 338 end if 339 LIBPAW_POINTER_ALLOCATE(v_dijhat,(cplex*nfft,nspden)) 340 v_dijhat_allocated=.true. 341 !v_dijhat=vtrial-vxc 342 do idij=1,nspden 343 do klmn=1,cplex*nfft 344 v_dijhat(klmn,idij)=vtrial(klmn,idij)-vxc(klmn,idij) 345 end do 346 end do 347 else 348 v_dijhat => vtrial 349 end if 350 end if 351 end if 352 353 !------------------------------------------------------------------------ 354 !----- Loop over atoms 355 !------------------------------------------------------------------------ 356 357 do iatom=1,my_natom 358 iatom_tot=iatom;if (paral_atom) iatom_tot=my_atmtab(iatom) 359 360 ! === Atom-dependent data === 361 362 itypat=paw_ij(iatom)%itypat 363 cplex_dij=paw_ij(iatom)%cplex_dij 364 cplex_rf=paw_ij(iatom)%cplex_rf 365 lm_size=paw_an(iatom)%lm_size 366 lmn2_size=paw_ij(iatom)%lmn2_size 367 ndij=paw_ij(iatom)%ndij 368 need_to_print=((abs(pawprtvol)>=1).and. & 369 & (iatom_tot==1.or.iatom_tot==natom.or.pawprtvol<0)) 370 pawu_new_algo=(pawtab(itypat)%usepawu==5.or.pawtab(itypat)%usepawu==6) 371 372 ! === Determine which conditions and prerequisites are fulfilled for Dij === 373 374 if (my_natom>0) then 375 ! Total Dij: no condition ; no prerequisites 376 dij_available=.true.;dij_prereq=.true. 377 ! Dij0: not available for RF ; need kij for the positron 378 dij0_available=(ipert<=0);dij0_prereq=(ipositron/=1.or.pawtab(itypat)%has_kij==2) 379 ! DijFock:not available for RF, positron; only for Fock exact exch. ; Vxc_ex needed 380 dijfock_available=(paw_ij(iatom)%has_dijfock>0.and.ipert<=0.and.ipositron/=1) 381 dijfock_prereq=(paw_ij(iatom)%has_dijfock==2) 382 ! DijHartree: no condition ; no prerequisites 383 dijhartree_available=.true.;dijhartree_prereq=.true. 384 ! DijXC: no condition ; Vxc needed 385 dijxc_available=.true. 386 dijxc_prereq=(paw_ij(iatom)%has_dijxc==2.or.paw_an(iatom)%has_vxc>0) 387 ! Dij^hat: no condition ; no prerequisites 388 dijhat_available=.true.;dijhat_prereq=.true. 389 ! Dij^hat_FR: only for RF and when it was previously computed 390 dijhatfr_available=(ipert>0.and.paw_ij(iatom)%has_dijfr==2) ; dijhatfr_prereq=.true. 391 ! DijND: not available for RF, requires non-zero nucdipmom 392 dijnd_available=.false. ; dijnd_prereq=(cplex_dij==2) 393 if (has_nucdipmom) dijnd_available=(ipert<=0.and.any(abs(nucdipmom(:,iatom))>tol8)) 394 ! DijSO: not available for RF, positron; only for spin-orbit ; VHartree and Vxc needed 395 dijso_available=(pawspnorb>0.and.ipert<=0.and.ipositron/=1) 396 dijso_prereq=(paw_ij(iatom)%has_dijso==2.or.& 397 & (paw_an(iatom)%has_vhartree>0.and.paw_an(iatom)%has_vxc>0)) 398 ! DijU: not available for positron; only for LDA+U 399 dijU_available=(pawtab(itypat)%usepawu>0.and.ipositron/=1.and. & 400 & (ipert<=0.or.pawu_new_algo)) 401 dijU_prereq=(paw_ij(iatom)%has_dijU==2.or.paw_ij(iatom)%has_pawu_occ>0.or. & 402 & (pawu_new_algo.and.paw_ij(iatom)%has_dijU>0)) 403 ! DijExxc: not available for RF, positron; only for local exact exch. ; Vxc_ex needed 404 dijexxc_available=(pawtab(itypat)%useexexch>0.and.ipert<=0.and.ipositron/=1) 405 dijexxc_prereq=(paw_ij(iatom)%has_dijexxc==2.or.paw_ij(iatom)%has_exexch_pot>0) 406 ! DijXC^hat: not available for RF ; Vxc needed 407 dijxchat_available=(ipert<=0) 408 dijxchat_prereq=(paw_ij(iatom)%has_dijxc_hat==2.or.paw_an(iatom)%has_vxc>0) 409 ! DijXC_val: not available for RF ; Vxc_val needed 410 dijxcval_available=(ipert<=0) 411 dijxcval_prereq=(paw_ij(iatom)%has_dijxc_val==2.or.paw_an(iatom)%has_vxcval>0) 412 end if 413 414 ! === Determine which parts of Dij have to be computed === 415 416 dij_need=.false.;dij0_need=.false.;dijexxc_need=.false.;dijfock_need=.false. 417 dijhartree_need=.false.;dijhat_need=.false.;dijhatfr_need=.false.; 418 dijso_need=.false.;dijU_need=.false.;dijxc_need=.false.;dijxchat_need=.false. 419 dijxcval_need=.false.; dijnd_need=.false. 420 421 if (dij_available) then 422 if (paw_ij(iatom)%has_dij==1) then 423 dij_need=.true.;paw_ij(iatom)%dij(:,:)=zero 424 else if (paw_ij(iatom)%has_dij==0.and.need_to_print) then 425 LIBPAW_ALLOCATE(paw_ij(iatom)%dij,(cplex_rf*cplex_dij*lmn2_size,ndij)) 426 dij_need=.true.;paw_ij(iatom)%dij(:,:)=zero 427 paw_ij(iatom)%has_dij=-1 428 end if 429 else if (paw_ij(iatom)%has_dij==1) then 430 paw_ij(iatom)%dij=zero 431 end if 432 433 if (dij0_available) then 434 if (paw_ij(iatom)%has_dij0==1) then 435 dij0_need=.true.;paw_ij(iatom)%dij0(:)=zero 436 else if (paw_ij(iatom)%has_dij0==0.and.need_to_print) then 437 LIBPAW_ALLOCATE(paw_ij(iatom)%dij0,(lmn2_size)) 438 dij0_need=.true.;paw_ij(iatom)%dij0(:)=zero 439 paw_ij(iatom)%has_dij0=-1 440 end if 441 else if (paw_ij(iatom)%has_dij0==1) then 442 paw_ij(iatom)%dij0=zero 443 end if 444 445 if (dijfock_available) then 446 if (paw_ij(iatom)%has_dijfock==1) then 447 dijfock_need=.true.;paw_ij(iatom)%dijfock(:,:)=zero 448 else if (paw_ij(iatom)%has_dijfock==0.and.need_to_print) then 449 LIBPAW_ALLOCATE(paw_ij(iatom)%dijfock,(cplex_dij*lmn2_size,ndij)) 450 dijfock_need=.true.;paw_ij(iatom)%dijfock(:,:)=zero 451 paw_ij(iatom)%has_dijfock=-1 452 end if 453 else if (paw_ij(iatom)%has_dijfock==1) then 454 paw_ij(iatom)%dijfock=zero 455 end if 456 457 if (dijhartree_available) then 458 if (paw_ij(iatom)%has_dijhartree==1) then 459 dijhartree_need=.true.;paw_ij(iatom)%dijhartree(:)=zero 460 else if (paw_ij(iatom)%has_dijhartree==0) then 461 LIBPAW_ALLOCATE(paw_ij(iatom)%dijhartree,(cplex_rf*lmn2_size)) 462 dijhartree_need=.true.;paw_ij(iatom)%dijhartree(:)=zero 463 paw_ij(iatom)%has_dijhartree=-1 464 end if 465 else if (paw_ij(iatom)%has_dijhartree==1) then 466 paw_ij(iatom)%dijhartree=zero 467 end if 468 469 if (dijxc_available) then 470 if (paw_ij(iatom)%has_dijxc==1) then 471 dijxc_need=.true.;paw_ij(iatom)%dijxc(:,:)=zero 472 else if (paw_ij(iatom)%has_dijxc==0.and.need_to_print) then 473 LIBPAW_ALLOCATE(paw_ij(iatom)%dijxc,(cplex_rf*cplex_dij*lmn2_size,ndij)) 474 dijxc_need=.true.;paw_ij(iatom)%dijxc(:,:)=zero 475 paw_ij(iatom)%has_dijxc=-1 476 end if 477 else if (paw_ij(iatom)%has_dijxc==1) then 478 paw_ij(iatom)%dijxc=zero 479 end if 480 481 if (dijhat_available) then 482 if (paw_ij(iatom)%has_dijhat==1) then 483 dijhat_need=.true.;paw_ij(iatom)%dijhat(:,:)=zero 484 else if (paw_ij(iatom)%has_dijhat==0.and.need_to_print) then 485 LIBPAW_ALLOCATE(paw_ij(iatom)%dijhat,(cplex_rf*cplex_dij*lmn2_size,ndij)) 486 dijhat_need=.true.;paw_ij(iatom)%dijhat(:,:)=zero 487 paw_ij(iatom)%has_dijhat=-1 488 end if 489 else if (paw_ij(iatom)%has_dijhat==1) then 490 paw_ij(iatom)%dijhat=zero 491 end if 492 493 if (dijnd_available) then 494 if (paw_ij(iatom)%has_dijnd==1) then 495 dijnd_need=.true.;paw_ij(iatom)%dijnd(:,:)=zero 496 else if (paw_ij(iatom)%has_dijnd==0.and.need_to_print) then 497 LIBPAW_ALLOCATE(paw_ij(iatom)%dijnd,(cplex_dij*lmn2_size,ndij)) 498 dijnd_need=.true.;paw_ij(iatom)%dijnd(:,:)=zero 499 paw_ij(iatom)%has_dijnd=-1 500 end if 501 else if (paw_ij(iatom)%has_dijnd==1) then 502 paw_ij(iatom)%dijnd=zero 503 end if 504 505 if (dijso_available) then 506 if (paw_ij(iatom)%has_dijso==1) then 507 dijso_need=.true.;paw_ij(iatom)%dijso(:,:)=zero 508 else if (paw_ij(iatom)%has_dijso==0.and.need_to_print) then 509 LIBPAW_ALLOCATE(paw_ij(iatom)%dijso,(cplex_rf*cplex_dij*lmn2_size,ndij)) 510 dijso_need=.true.;paw_ij(iatom)%dijso(:,:)=zero 511 paw_ij(iatom)%has_dijso=-1 512 end if 513 else if (paw_ij(iatom)%has_dijso==1) then 514 paw_ij(iatom)%dijso=zero 515 end if 516 517 if (dijU_available) then 518 if (paw_ij(iatom)%has_dijU==1) then 519 dijU_need=.true.;paw_ij(iatom)%dijU(:,:)=zero 520 else if (paw_ij(iatom)%has_dijU==0.and.need_to_print) then 521 LIBPAW_ALLOCATE(paw_ij(iatom)%dijU,(cplex_rf*cplex_dij*lmn2_size,ndij)) 522 dijU_need=.true.;paw_ij(iatom)%dijU(:,:)=zero 523 paw_ij(iatom)%has_dijU=-1 524 end if 525 else if (paw_ij(iatom)%has_dijU==1) then 526 paw_ij(iatom)%dijU=zero 527 end if 528 529 if (dijexxc_available.and.paw_ij(iatom)%has_dijexxc/=2) then 530 if (paw_ij(iatom)%has_dijexxc==1) then 531 dijexxc_need=.true.;paw_ij(iatom)%dijexxc(:,:)=zero 532 else if (paw_ij(iatom)%has_dijexxc==0.and.need_to_print) then 533 LIBPAW_ALLOCATE(paw_ij(iatom)%dijexxc,(cplex_dij*lmn2_size,ndij)) 534 dijexxc_need=.true.;paw_ij(iatom)%dijexxc(:,:)=zero 535 paw_ij(iatom)%has_dijexxc=-1 536 end if 537 else if (paw_ij(iatom)%has_dijexxc==1) then 538 paw_ij(iatom)%dijexxc=zero 539 end if 540 541 if (dijxchat_available) then 542 if (paw_ij(iatom)%has_dijxc_hat==1) then 543 dijxchat_need=.true.;paw_ij(iatom)%dijxc_hat(:,:)=zero 544 ! else if (paw_ij(iatom)%has_dijxc_hat==0.and.need_to_print) then 545 ! LIBPAW_ALLOCATE(paw_ij(iatom)%dijxc_hat,(cplex_rf*cplex_dij*lmn2_size,ndij)) 546 ! dijxchat_need=.true.;paw_ij(iatom)%dijxc_hat(:,:)=zero 547 ! paw_ij(iatom)%has_dijxc_hat=-1 548 end if 549 else if (paw_ij(iatom)%has_dijxc_hat==1) then 550 paw_ij(iatom)%dijxc_hat=zero 551 end if 552 553 if (dijxcval_available) then 554 if (paw_ij(iatom)%has_dijxc_val==1) then 555 dijxcval_need=.true.;paw_ij(iatom)%dijxc_val(:,:)=zero 556 ! else if (paw_ij(iatom)%has_dijxc_val==0.and.need_to_print) then 557 ! LIBPAW_ALLOCATE(paw_ij(iatom)%dijxc_val,(cplex_rf*cplex_dij*lmn2_size,ndij)) 558 ! dijxcval_need=.true.;paw_ij(iatom)%dijxc_val(:,:)=zero 559 ! paw_ij(iatom)%has_dijxc_val=-1 560 end if 561 else if (paw_ij(iatom)%has_dijxc_val==1) then 562 paw_ij(iatom)%dijxc_val=zero 563 end if 564 565 ! === Print error messages if prerequisites are not fulfilled === 566 567 if (dij_need.and.(.not.dij_prereq)) then 568 msg='Dij prerequisites missing!' 569 MSG_BUG(msg) 570 end if 571 if (dij0_need.and.(.not.dij0_prereq)) then 572 msg='Dij0 prerequisites missing!' 573 MSG_BUG(msg) 574 end if 575 if (dijfock_need.and.(.not.dijfock_prereq)) then 576 msg='DijFock prerequisites missing!' 577 MSG_BUG(msg) 578 end if 579 580 if (dijhartree_need.and.(.not.dijhartree_prereq)) then 581 msg='DijHartree prerequisites missing!' 582 MSG_BUG(msg) 583 end if 584 if (dijxc_need.and.(.not.dijxc_prereq)) then 585 msg='Dij^XC prerequisites missing!' 586 MSG_BUG(msg) 587 end if 588 if (dijhat_need.and.(.not.dijhat_prereq)) then 589 msg='Dij^hat prerequisites missing!' 590 MSG_BUG(msg) 591 end if 592 if (dijhatfr_need.and.(.not.dijhatfr_prereq)) then 593 msg='DijFR^hat prerequisites missing!' 594 MSG_BUG(msg) 595 end if 596 if (dijnd_need.and.(.not.dijnd_prereq)) then 597 msg='DijND prerequisites missing!' 598 MSG_BUG(msg) 599 end if 600 if (dijso_need.and.(.not.dijso_prereq)) then 601 msg='DijSO prerequisites missing!' 602 MSG_BUG(msg) 603 end if 604 if (dijU_need.and.(.not.dijU_prereq)) then 605 msg='DijU prerequisites missing!' 606 MSG_BUG(msg) 607 end if 608 if (dijexxc_need.and.(.not.dijexxc_prereq)) then 609 msg='DijExcc prerequisites missing!' 610 MSG_BUG(msg) 611 end if 612 if (dijxchat_need.and.(.not.dijxchat_prereq)) then 613 msg='DijXC^hat prerequisites missing!' 614 MSG_BUG(msg) 615 end if 616 if (dijxcval_need.and.(.not.dijxcval_prereq)) then 617 msg='DijXC_val prerequisites missing!' 618 MSG_BUG(msg) 619 end if 620 621 ! ------------------------------------------------------------------------ 622 ! ----------- Add atomic Dij0 to Dij 623 ! ------------------------------------------------------------------------ 624 625 if ((dij0_need.or.dij_need).and.dij0_available) then 626 627 LIBPAW_ALLOCATE(dij0,(lmn2_size)) 628 ! ===== Dij0 already computed 629 if (paw_ij(iatom)%has_dij0==2) then 630 dij0(:)=paw_ij(iatom)%dij0(:) 631 else 632 ! ===== Need to compute Dij0 633 dij0(:)=pawtab(itypat)%dij0(:) 634 if (ipositron==1) dij0(:)=two*pawtab(itypat)%kij(:)-dij0(:) 635 if (pawtab(itypat)%usepawu==5) dij0(:)=dij0(:)+pawtab(itypat)%euij_fll(:) 636 if (dij0_need) paw_ij(iatom)%dij0(:)=dij0(:) 637 end if 638 639 if (dij_need) then 640 do idij=1,min(nsploop,2) 641 klmn1=1 642 do klmn=1,lmn2_size 643 paw_ij(iatom)%dij(klmn1,idij)=paw_ij(iatom)%dij(klmn1,idij)+dij0(klmn) 644 klmn1=klmn1+cplex_dij 645 end do 646 end do 647 end if 648 LIBPAW_DEALLOCATE(dij0) 649 end if 650 651 ! ------------------------------------------------------------------------ 652 ! ------------------------------------------------------------------------ 653 ! ----------- Add Dij_{Fock exact-exchange} to Dij 654 ! ------------------------------------------------------------------------ 655 656 if ((dijfock_need.or.dij_need).and.dijfock_available) then 657 658 ! ===== DijFock already computed 659 if (paw_ij(iatom)%has_dijfock==2) then 660 if (dij_need) paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:)= & 661 & paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:) & 662 & +paw_ij(iatom)%dijfock(1:cplex_dij*lmn2_size,:) 663 664 else 665 666 ! ===== Need to compute DijFock 667 LIBPAW_ALLOCATE(dijfock_vv,(cplex_dij*lmn2_size,ndij)) 668 LIBPAW_ALLOCATE(dijfock_cv,(cplex_dij*lmn2_size,ndij)) 669 dijfock_vv(:,:)=zero ; dijfock_cv(:,:)=zero 670 ! Exact exchange is evaluated for electrons only 671 if (ipositron/=1) then 672 call pawdijfock(cplex_rf,cplex_dij,dijfock_vv,dijfock_cv,hyb_mixing_,hyb_mixing_sr_, & 673 & ndij,nspden,nsppol,pawrhoij(iatom),pawtab(itypat)) 674 end if 675 if (dijfock_need) paw_ij(iatom)%dijfock(:,:)=dijfock_vv(:,:)+dijfock_cv(:,:) 676 if (dij_need) paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:)= & 677 & paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:) & 678 & +dijfock_vv(1:cplex_dij*lmn2_size,:)+dijfock_cv(1:cplex_dij*lmn2_size,:) 679 LIBPAW_DEALLOCATE(dijfock_vv) 680 LIBPAW_DEALLOCATE(dijfock_cv) 681 end if 682 end if 683 684 ! ----------- Add Dij_Hartree to Dij 685 ! ------------------------------------------------------------------------ 686 687 if ((dijhartree_need.or.dij_need).and.dijhartree_available) then 688 689 LIBPAW_ALLOCATE(dijhartree,(cplex_rf*lmn2_size)) 690 ! ===== DijHartree already computed 691 if (paw_ij(iatom)%has_dijhartree==2) then 692 dijhartree(:)=paw_ij(iatom)%dijhartree(:) 693 else 694 ! ===== Need to compute DijHartree 695 if (ipositron/=1) then 696 call pawdijhartree(cplex_rf,dijhartree,nspden,pawrhoij(iatom),pawtab(itypat)) 697 else 698 dijhartree(:)=zero 699 end if 700 if (ipositron/=0) then 701 LIBPAW_ALLOCATE(dij_ep,(cplex_rf*lmn2_size)) 702 call pawdijhartree(cplex_rf,dij_ep,nspden,electronpositron_pawrhoij(iatom),pawtab(itypat)) 703 dijhartree(:)=dijhartree(:)-dij_ep(:) 704 LIBPAW_DEALLOCATE(dij_ep) 705 end if 706 if (dijhartree_need) paw_ij(iatom)%dijhartree(:)=dijhartree(:) 707 end if 708 709 if (dij_need) then 710 do idij=1,min(nsploop,2) 711 klmn1=1 712 do klmn=1,cplex_rf*lmn2_size 713 paw_ij(iatom)%dij(klmn1,idij)=paw_ij(iatom)%dij(klmn1,idij)+dijhartree(klmn) 714 klmn1=klmn1+cplex_dij 715 end do 716 end do 717 end if 718 719 LIBPAW_DEALLOCATE(dijhartree) 720 end if 721 722 ! ------------------------------------------------------------------------ 723 ! ----------- Add Dij_xc to Dij 724 ! ------------------------------------------------------------------------ 725 726 if ((dijxc_need.or.dij_need).and.dijxc_available) then 727 728 ! ===== Dijxc already computed 729 if (paw_ij(iatom)%has_dijxc==2) then 730 if (dij_need) paw_ij(iatom)%dij(:,:)=paw_ij(iatom)%dij(:,:)+paw_ij(iatom)%dijxc(:,:) 731 else 732 733 ! ===== Need to compute DijXC 734 LIBPAW_ALLOCATE(dijxc,(cplex_rf*cplex_dij*lmn2_size,ndij)) 735 if (pawxcdev/=0) then 736 LIBPAW_ALLOCATE(lmselect,(lm_size)) 737 lmselect(:)=paw_an(iatom)%lmselect(:) 738 if (ipositron/=0) lmselect(:)=(lmselect(:).or.electronpositron_lmselect(1:lm_size,iatom)) 739 call pawdijxcm(cplex_rf,cplex_dij,dijxc,lmselect,ndij,nspden,nsppol,pawang,& 740 & pawrad(itypat),pawtab(itypat),paw_an(iatom)%vxc1,& 741 & paw_an(iatom)%vxct1,usexcnhat) 742 LIBPAW_DEALLOCATE(lmselect) 743 else 744 call pawdijxc(cplex_rf,cplex_dij,dijxc,ndij,nspden,nsppol,& 745 & pawang,pawrad(itypat),pawtab(itypat),paw_an(iatom)%vxc1,& 746 & paw_an(iatom)%vxct1,usexcnhat) 747 end if 748 if (dijxc_need) paw_ij(iatom)%dijxc(:,:)=dijxc(:,:) 749 if (dij_need) paw_ij(iatom)%dij(:,:)=paw_ij(iatom)%dij(:,:)+dijxc(:,:) 750 LIBPAW_DEALLOCATE(dijxc) 751 end if 752 753 end if 754 755 ! ------------------------------------------------------------------------ 756 ! ----------- Add Dij_hat to Dij 757 ! ------------------------------------------------------------------------ 758 759 if ((dijhat_need.or.dij_need).and.dijhat_available) then 760 761 ! ===== Dijhat already computed 762 if (paw_ij(iatom)%has_dijhat==2) then 763 if (dij_need) paw_ij(iatom)%dij(:,:)=paw_ij(iatom)%dij(:,:)+paw_ij(iatom)%dijhat(:,:) 764 else 765 766 ! ===== Need to compute Dijhat 767 LIBPAW_ALLOCATE(dijhat,(cplex_rf*cplex_dij*lmn2_size,ndij)) 768 call pawdijhat(cplex_rf,cplex_dij,dijhat,gprimd,iatom_tot,ipert,& 769 & natom,ndij,nfft,nfftot,nspden,nsppol,pawang,pawfgrtab(iatom),& 770 & pawtab(itypat),v_dijhat,qphon,ucvol,xred,mpi_comm_grid=my_comm_grid) 771 if (dijhat_need) paw_ij(iatom)%dijhat(:,:)=dijhat(:,:) 772 if (dij_need) paw_ij(iatom)%dij(:,:)=paw_ij(iatom)%dij(:,:)+dijhat(:,:) 773 LIBPAW_DEALLOCATE(dijhat) 774 end if 775 776 ! ===== RF: add frozen part of 1st-order Dij 777 if (dijhatfr_available) then 778 do idij=1,nsploop 779 if (dij_need) paw_ij(iatom)%dij(:,idij)=paw_ij(iatom)%dij(:,idij) & 780 & +paw_ij(iatom)%dijfr(:,idij) 781 if (dijhat_need) paw_ij(iatom)%dijhat(:,idij)=paw_ij(iatom)%dijhat(:,idij) & 782 & +paw_ij(iatom)%dijfr(:,idij) 783 end do 784 end if 785 786 end if 787 788 ! ------------------------------------------------------------------------ 789 ! ----------- Add Dij nuclear dipole moments to Dij 790 ! ------------------------------------------------------------------------ 791 792 if ((dijnd_need.or.dij_need).and.dijnd_available) then 793 794 ! ===== Dijnd already computed 795 if (paw_ij(iatom)%has_dijnd==2) then 796 if (dij_need) paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:)= & 797 & paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:) & 798 & +paw_ij(iatom)%dijnd(1:cplex_dij*lmn2_size,:) 799 else 800 801 ! ===== Need to compute Dijnd 802 LIBPAW_ALLOCATE(dijnd,(cplex_dij*lmn2_size,ndij)) 803 call pawdijnd(cplex_dij,dijnd,ndij,nucdipmom(:,iatom),pawrad(itypat),pawtab(itypat)) 804 if (dijnd_need) paw_ij(iatom)%dijnd(:,:)=dijnd(:,:) 805 if (dij_need) paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:)= & 806 & paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:) & 807 & +dijnd(1:cplex_dij*lmn2_size,:) 808 LIBPAW_DEALLOCATE(dijnd) 809 end if 810 811 end if 812 813 814 ! ------------------------------------------------------------------------ 815 ! ----------- Add Dij spin-orbit to Dij 816 ! ------------------------------------------------------------------------ 817 818 if ((dijso_need.or.dij_need).and.dijso_available) then 819 820 ! ===== DijSO already computed 821 if (paw_ij(iatom)%has_dijso==2) then 822 if (dij_need) paw_ij(iatom)%dij(:,:)=paw_ij(iatom)%dij(:,:)+paw_ij(iatom)%dijso(:,:) 823 else 824 825 ! ===== Need to compute DijSO 826 LIBPAW_ALLOCATE(dijso,(cplex_rf*cplex_dij*lmn2_size,ndij)) 827 call pawdijso(cplex_rf,cplex_dij,dijso,ndij,nspden,& 828 & pawang,pawrad(itypat),pawtab(itypat),pawxcdev,spnorbscl,& 829 & paw_an(iatom)%vh1,paw_an(iatom)%vxc1) 830 if (dijso_need) paw_ij(iatom)%dijso(:,:)=dijso(:,:) 831 if (dij_need) paw_ij(iatom)%dij(:,:)=paw_ij(iatom)%dij(:,:)+dijso(:,:) 832 LIBPAW_DEALLOCATE(dijso) 833 end if 834 835 end if 836 837 ! ------------------------------------------------------------------------ 838 ! ----------- Add Dij_{LDA+U} to Dij 839 ! ------------------------------------------------------------------------ 840 841 if ((dijU_need.or.dij_need).and.dijU_available) then 842 843 ! ===== DijU already computed 844 if (paw_ij(iatom)%has_dijU==2) then 845 if (dij_need) paw_ij(iatom)%dij(:,:)=paw_ij(iatom)%dij(:,:)+paw_ij(iatom)%dijU(:,:) 846 else 847 848 ! ===== Need to compute DijU 849 LIBPAW_ALLOCATE(dijpawu,(cplex_rf*cplex_dij*lmn2_size,ndij)) 850 if (pawu_new_algo) then 851 call pawdiju_euijkl(cplex_rf,cplex_dij,dijpawu,ndij,pawrhoij(iatom),pawtab(itypat)) 852 else 853 lpawu=pawtab(itypat)%lpawu 854 LIBPAW_POINTER_ALLOCATE(vpawu,(cplex_dij,lpawu*2+1,lpawu*2+1,ndij)) 855 if (pawtab(itypat)%usepawu>=10) vpawu=zero ! if dmft, do not apply U in LDA+U 856 if (pawtab(itypat)%usepawu< 10) then 857 call pawpupot(cplex_dij,ndij,paw_ij(iatom)%noccmmp,paw_ij(iatom)%nocctot,& 858 & pawprtvol,pawtab(itypat),vpawu) 859 end if 860 if (natvshift_==0) then 861 call pawdiju(cplex_rf,cplex_dij,dijpawu,ndij,nsppol,pawtab(itypat),vpawu) 862 else 863 call pawdiju(cplex_rf,cplex_dij,dijpawu,ndij,nsppol,pawtab(itypat),vpawu,& 864 & natvshift=natvshift_,atvshift=atvshift(:,:,iatom_tot),& 865 & fatvshift=fatvshift) 866 end if 867 LIBPAW_POINTER_DEALLOCATE(vpawu) 868 end if 869 if (dijU_need) paw_ij(iatom)%dijU(:,:)=dijpawu(:,:) 870 if (dij_need) paw_ij(iatom)%dij(:,:)=paw_ij(iatom)%dij(:,:)+dijpawu(:,:) 871 LIBPAW_DEALLOCATE(dijpawu) 872 end if 873 874 end if 875 876 ! ------------------------------------------------------------------------ 877 ! ----------- Add Dij_{local exact-exchange} to Dij 878 ! ------------------------------------------------------------------------ 879 880 if ((dijexxc_need.or.dij_need).and.dijexxc_available) then 881 882 ! ===== DijEXXC already computed 883 if (paw_ij(iatom)%has_dijexxc==2) then 884 if (dij_need) paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:)= & 885 & paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:) & 886 & +paw_ij(iatom)%dijexxc(1:cplex_dij*lmn2_size,:) 887 else 888 889 ! ===== Need to compute DijEXXC 890 LIBPAW_ALLOCATE(dijexxc,(cplex_dij*lmn2_size,ndij)) 891 if (pawxcdev/=0) then 892 if (paw_ij(iatom)%has_exexch_pot/=2) then 893 LIBPAW_POINTER_ALLOCATE(vpawx,(1,lmn2_size,ndij)) 894 call pawxpot(ndij,pawprtvol,pawrhoij(iatom),pawtab(itypat),vpawx) 895 else 896 vpawx=>paw_ij(iatom)%vpawx 897 end if 898 LIBPAW_ALLOCATE(lmselect,(lm_size)) 899 lmselect(:)=paw_an(iatom)%lmselect(:) 900 if (ipositron/=0) lmselect(:)=(lmselect(:).or.electronpositron_lmselect(1:lm_size,iatom)) 901 call pawdijexxc(cplex_rf,cplex_dij,dijexxc,lmselect,ndij,nspden,nsppol,& 902 & pawang,pawrad(itypat),pawtab(itypat),vpawx,paw_an(iatom)%vxc_ex) 903 LIBPAW_DEALLOCATE(lmselect) 904 if (paw_ij(iatom)%has_exexch_pot/=2) then 905 LIBPAW_POINTER_DEALLOCATE(vpawx) 906 end if 907 if (dijexxc_need) paw_ij(iatom)%dijexxc(:,:)=dijexxc(:,:) 908 if (dij_need) paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:)= & 909 & paw_ij(iatom)%dij(1:cplex_dij*lmn2_size,:) & 910 & +dijexxc(1:cplex_dij*lmn2_size,:) 911 LIBPAW_DEALLOCATE(dijexxc) 912 end if 913 end if 914 915 end if 916 917 ! ------------------------------------------------------------------------ 918 ! ----------- Add Dij background contribution to the total Dij 919 ! ------------------------------------------------------------------------ 920 921 if (dij_need.and.pawtab(itypat)%usepotzero==1 ) then 922 do idij=1,min(nsploop,2) 923 klmn1=1 924 do klmn=1,lmn2_size 925 paw_ij(iatom)%dij(klmn1,idij)=paw_ij(iatom)%dij(klmn1,idij)+pawtab(itypat)%gammaij(klmn)*charge/ucvol 926 klmn1=klmn1+cplex_dij*cplex_rf 927 end do 928 end do 929 end if 930 931 932 ! ------------------------------------------------------------------------ 933 ! ----------- Compute Dijxc_hat 934 ! ------------------------------------------------------------------------ 935 936 if (dijxchat_need) then 937 938 if (usexcnhat/=0) then 939 LIBPAW_ALLOCATE(dijxchat,(cplex_dij*lmn2_size,ndij)) 940 call pawdijhat(1,cplex_dij,dijxchat,gprimd,iatom_tot,ipert,& 941 & natom,ndij,nfft,nfftot,nspden,nsppol,pawang,pawfgrtab(iatom),& 942 & pawtab(itypat),vxc,qphon,ucvol,xred,mpi_comm_grid=my_comm_grid) 943 paw_ij(iatom)%dijxc_hat(1:cplex_dij*lmn2_size,:)=dijxchat(1:cplex_dij*lmn2_size,:) 944 LIBPAW_DEALLOCATE(dijxchat) 945 946 else ! usexcnhat=0 947 paw_ij(iatom)%dijxc_hat=zero 948 end if 949 950 end if 951 952 ! ------------------------------------------------------------------------ 953 ! ----------- Compute Dijxc_val 954 ! ------------------------------------------------------------------------ 955 956 if (dijxcval_need) then 957 958 LIBPAW_ALLOCATE(dijxcval,(cplex_dij*lmn2_size,ndij)) 959 ! Note that usexcnhat=0 for this call (no compensation term) 960 if (pawxcdev/=0) then 961 LIBPAW_ALLOCATE(lmselect,(lm_size)) 962 lmselect(:)=paw_an(iatom)%lmselect(:) 963 if (ipositron/=0) lmselect(:)=(lmselect(:).or.electronpositron_lmselect(1:lm_size,iatom)) 964 call pawdijxcm(1,cplex_dij,dijxcval,lmselect,ndij,nspden,nsppol,& 965 & pawang,pawrad(itypat),pawtab(itypat),paw_an(iatom)%vxc1_val,& 966 & paw_an(iatom)%vxct1_val,0) 967 LIBPAW_DEALLOCATE(lmselect) 968 else 969 call pawdijxc(1,cplex_dij,dijxcval,ndij,nspden,nsppol,& 970 & pawang,pawrad(itypat),pawtab(itypat),paw_an(iatom)%vxc1_val,& 971 & paw_an(iatom)%vxct1_val,0) 972 end if 973 paw_ij(iatom)%dijxc_val(1:cplex_dij*lmn2_size,:)=dijxcval(1:cplex_dij*lmn2_size,:) 974 LIBPAW_DEALLOCATE(dijxcval) 975 976 end if 977 978 ! ------------------------------------------------------------------------ 979 980 ! Update some flags 981 if (dij_need.and.paw_ij(iatom)%has_dij>=1) paw_ij(iatom)%has_dij=2 982 if (dij0_need.and.paw_ij(iatom)%has_dij0>=1) paw_ij(iatom)%has_dij0=2 983 if (dijfock_need.and.paw_ij(iatom)%has_dijfock>=1) paw_ij(iatom)%has_dijfock=2 984 985 if (dijhartree_need.and.paw_ij(iatom)%has_dijhartree>=1) paw_ij(iatom)%has_dijhartree=2 986 if (dijxc_need.and.paw_ij(iatom)%has_dijxc>=1) paw_ij(iatom)%has_dijxc=2 987 if (dijhat_need.and.paw_ij(iatom)%has_dijhat>=1) paw_ij(iatom)%has_dijhat=2 988 if (dijnd_need.and.paw_ij(iatom)%has_dijnd>=1) paw_ij(iatom)%has_dijnd=2 989 if (dijso_need.and.paw_ij(iatom)%has_dijso>=1) paw_ij(iatom)%has_dijso=2 990 if (dijU_need.and.paw_ij(iatom)%has_dijU>=1) paw_ij(iatom)%has_dijU=2 991 if (dijexxc_need.and.paw_ij(iatom)%has_dijexxc>=1) paw_ij(iatom)%has_dijexxc=2 992 if (dijxchat_need.and.paw_ij(iatom)%has_dijxc_hat>=1) paw_ij(iatom)%has_dijxc_hat=2 993 if (dijxcval_need.and.paw_ij(iatom)%has_dijxc_val>=1) paw_ij(iatom)%has_dijxc_val=2 994 995 !End loop over atoms 996 end do ! iatom 997 998 !------------------------------------------------------------------------ 999 1000 !Final printing 1001 if (paral_atom) then 1002 call paw_ij_print(paw_ij,unit=std_out,pawprtvol=pawprtvol,pawspnorb=pawspnorb,& 1003 & comm_atom=my_comm_atom,mpi_atmtab=my_atmtab,natom=natom,& 1004 & mode_paral='PERS',enunit=enunit,ipert=ipert) 1005 else 1006 call paw_ij_print(paw_ij,unit=std_out,pawprtvol=pawprtvol,pawspnorb=pawspnorb,& 1007 & mode_paral='COLL',enunit=enunit,ipert=ipert) 1008 end if 1009 1010 !Free temporary storage 1011 if (v_dijhat_allocated) then 1012 LIBPAW_POINTER_DEALLOCATE(v_dijhat) 1013 end if 1014 do iatom=1,my_natom 1015 if (paw_ij(iatom)%has_dij0==-1) then 1016 LIBPAW_DEALLOCATE(paw_ij(iatom)%dij0) 1017 paw_ij(iatom)%has_dij0=0 1018 end if 1019 if (paw_ij(iatom)%has_dijfock==-1) then 1020 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijfock) 1021 paw_ij(iatom)%has_dijfock=0 1022 end if 1023 1024 if (paw_ij(iatom)%has_dijhartree==-1) then 1025 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijhartree) 1026 paw_ij(iatom)%has_dijhartree=0 1027 end if 1028 if (paw_ij(iatom)%has_dijxc==-1) then 1029 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijxc) 1030 paw_ij(iatom)%has_dijxc=0 1031 end if 1032 if (paw_ij(iatom)%has_dijhat==-1) then 1033 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijhat) 1034 paw_ij(iatom)%has_dijhat=0 1035 end if 1036 if (paw_ij(iatom)%has_dijfr==-1) then 1037 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijfr) 1038 paw_ij(iatom)%has_dijfr=0 1039 end if 1040 if (paw_ij(iatom)%has_dijso==-1) then 1041 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijso) 1042 paw_ij(iatom)%has_dijso=0 1043 end if 1044 if (paw_ij(iatom)%has_dijU==-1) then 1045 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijU) 1046 paw_ij(iatom)%has_dijU=0 1047 end if 1048 if (paw_ij(iatom)%has_dijexxc==-1) then 1049 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijexxc) 1050 paw_ij(iatom)%has_dijexxc=0 1051 end if 1052 if (paw_ij(iatom)%has_dijxc_hat==-1) then 1053 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijxc_hat) 1054 paw_ij(iatom)%has_dijxc_hat=0 1055 end if 1056 if (paw_ij(iatom)%has_dijxc_val==-1) then 1057 LIBPAW_DEALLOCATE(paw_ij(iatom)%dijxc_val) 1058 paw_ij(iatom)%has_dijxc_val=0 1059 end if 1060 end do 1061 1062 !Destroy atom table used for parallelism 1063 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 1064 1065 end subroutine pawdij
m_pawdij/pawdij_gather [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdij_gather
FUNCTION
Performs a ALLGATHER operation (over atomic sites) on Dij data stored as a 1D array of Dij arrays.
INPUTS
dij_in = coeff2d_type array containing the input Dij comm_atom= MPI communicator over atoms mpi_atmtab(:)=indexes of the atoms treated by current proc
OUTPUT
dij_out = coeff2d_type array containing the gathered Dij
PARENTS
m_pawdij
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
5476 subroutine pawdij_gather(dij_in,dij_out,comm_atom,mpi_atmtab) 5477 5478 5479 !This section has been created automatically by the script Abilint (TD). 5480 !Do not modify the following lines by hand. 5481 #undef ABI_FUNC 5482 #define ABI_FUNC 'pawdij_gather' 5483 !End of the abilint section 5484 5485 implicit none 5486 5487 !Arguments ------------------------------------ 5488 !scalars 5489 integer,intent(in) :: comm_atom 5490 !arrays 5491 integer,intent(in) :: mpi_atmtab(:) 5492 type(coeff2_type),intent(in) :: dij_in(:) 5493 type(coeff2_type),intent(out) :: dij_out(:) 5494 5495 !Local variables------------------------------- 5496 !scalars 5497 integer :: buf_dp_size,buf_dp_size_all,buf_int_size,buf_int_size_all 5498 integer :: dij_size,dij_size_out,ierr,ii,i2,indx_dp,indx_int,ival,n1,n2,nproc 5499 !arrays 5500 integer :: bufsz(2) 5501 integer, allocatable :: buf_int(:),buf_int_all(:) 5502 integer, allocatable :: count_dp(:),count_int(:),count_tot(:),displ_dp(:),displ_int(:) 5503 integer, allocatable :: dimdij(:,:) 5504 real(dp),allocatable :: buf_dp(:),buf_dp_all(:) 5505 5506 ! ************************************************************************* 5507 5508 nproc=xmpi_comm_size(comm_atom) 5509 dij_size=size(dij_in,dim=1) 5510 5511 buf_dp_size=0 5512 LIBPAW_ALLOCATE(dimdij,(dij_size,2)) 5513 do ii=1,dij_size 5514 dimdij(ii,1)=size(dij_in(ii)%value,dim=1) 5515 dimdij(ii,2)=size(dij_in(ii)%value,dim=2) 5516 buf_dp_size=buf_dp_size+dimdij(ii,1)*dimdij(ii,2) 5517 end do 5518 5519 !If only one proc, perform a single copy 5520 if (nproc==1) then 5521 do ii=1,dij_size 5522 ival=mpi_atmtab(ii) 5523 if (allocated(dij_out(ival)%value)) then 5524 LIBPAW_DEALLOCATE(dij_out(ival)%value) 5525 end if 5526 LIBPAW_ALLOCATE(dij_out(ival)%value,(n1,n2)) 5527 dij_out(ii)%value=dij_in(ival)%value 5528 end do 5529 LIBPAW_DEALLOCATE(dimdij) 5530 return 5531 end if 5532 5533 !Fill in integer buffer 5534 buf_int_size=3*dij_size 5535 LIBPAW_ALLOCATE(buf_int,(buf_int_size)) 5536 indx_int=1 5537 do ii=1,dij_size 5538 buf_int(indx_int )=dimdij(ii,1) 5539 buf_int(indx_int+1)=dimdij(ii,2) 5540 buf_int(indx_int+2)=mpi_atmtab(ii) 5541 indx_int=indx_int+3 5542 end do 5543 5544 !Fill in real buffer 5545 LIBPAW_ALLOCATE(buf_dp,(buf_dp_size)) 5546 indx_dp=1 5547 do ii=1,dij_size 5548 n1=dimdij(ii,1); n2=dimdij(ii,2) 5549 do i2=1,n2 5550 buf_dp(indx_dp:indx_dp+n1-1)=dij_in(ii)%value(1:n1,i2) 5551 indx_dp=indx_dp+n1 5552 end do 5553 end do 5554 5555 !Communicate (1 gather for integers, 1 gather for reals) 5556 LIBPAW_ALLOCATE(count_int,(nproc)) 5557 LIBPAW_ALLOCATE(displ_int,(nproc)) 5558 LIBPAW_ALLOCATE(count_dp ,(nproc)) 5559 LIBPAW_ALLOCATE(displ_dp ,(nproc)) 5560 LIBPAW_ALLOCATE(count_tot,(2*nproc)) 5561 bufsz(1)=buf_int_size; bufsz(2)=buf_dp_size 5562 call xmpi_allgather(bufsz,2,count_tot,comm_atom,ierr) 5563 do ii=1,nproc 5564 count_int(ii)=count_tot(2*ii-1) 5565 count_dp (ii)=count_tot(2*ii) 5566 end do 5567 displ_int(1)=0;displ_dp(1)=0 5568 do ii=2,nproc 5569 displ_int(ii)=displ_int(ii-1)+count_int(ii-1) 5570 displ_dp (ii)=displ_dp (ii-1)+count_dp (ii-1) 5571 end do 5572 buf_int_size_all=sum(count_int) 5573 buf_dp_size_all =sum(count_dp) 5574 LIBPAW_DEALLOCATE(count_tot) 5575 LIBPAW_ALLOCATE(buf_int_all,(buf_int_size_all)) 5576 LIBPAW_ALLOCATE(buf_dp_all ,(buf_dp_size_all)) 5577 call xmpi_allgatherv(buf_int,buf_int_size,buf_int_all,count_int,displ_int,comm_atom,ierr) 5578 call xmpi_allgatherv(buf_dp ,buf_dp_size ,buf_dp_all ,count_dp ,displ_dp ,comm_atom,ierr) 5579 LIBPAW_DEALLOCATE(count_int) 5580 LIBPAW_DEALLOCATE(displ_int) 5581 LIBPAW_DEALLOCATE(count_dp) 5582 LIBPAW_DEALLOCATE(displ_dp) 5583 5584 !Retrieve gathered data 5585 dij_size_out=buf_int_size_all/3 5586 indx_int=1;indx_dp=1 5587 do ii=1,dij_size_out 5588 n1=buf_int_all(indx_int) 5589 n2=buf_int_all(indx_int+1) 5590 ival=buf_int_all(indx_int+2) 5591 indx_int=indx_int+3 5592 if (allocated(dij_out(ival)%value)) then 5593 LIBPAW_DEALLOCATE(dij_out(ival)%value) 5594 end if 5595 LIBPAW_ALLOCATE(dij_out(ival)%value,(n1,n2)) 5596 do i2=1,n2 5597 dij_out(ival)%value(1:n1,i2)=buf_dp_all(indx_dp:indx_dp+n1-1) 5598 indx_dp=indx_dp+n1 5599 end do 5600 end do 5601 5602 LIBPAW_DEALLOCATE(buf_dp_all) 5603 LIBPAW_DEALLOCATE(buf_int_all) 5604 LIBPAW_DEALLOCATE(buf_int) 5605 LIBPAW_DEALLOCATE(buf_dp) 5606 LIBPAW_DEALLOCATE(dimdij) 5607 5608 end subroutine pawdij_gather
m_pawdij/pawdij_print_ij [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdij_print_dij
FUNCTION
Print out the content of a Dij matrix (total Dij) in a suitable format
INPUTS
dij(cplex_rf*cplex_dij*lmn2_size,ndij)= input matrix to be printed cplex_dij=1 if Dij is real, 2 if Dij is complex cplex_rf=1 if Dij contains no RF phase, 2 if it contains a exp(-iqr) RF phase iatom=current atom natom=total number of atoms in the system nspden=number of spin density components nsppol = number of spin polarizations [Ha_or_eV]= 1: output in hartrees, 2: output in eV [opt_prtvol]= >=0 if up to 12 components of _ij matrix have to be printed <0 if all components of ij_ matrix have to be printed (optional) [mode_paral]= parallel printing mode (optional, default='COLL') [test_value]=(real number) if positive, print a warning when the magnitude of Dij is greater (optional) [title_msg]=message to print as title (optional) [unit]=the unit number for output (optional)
OUTPUT
(Only writing)
NOTES
PARENTS
m_pawdij
CHILDREN
SOURCE
5648 subroutine pawdij_print_dij(dij,cplex_dij,cplex_rf,iatom,natom,nspden,nsppol,& 5649 & test_value,title_msg,unit,Ha_or_eV,opt_prtvol,mode_paral) ! Optional arguments 5650 5651 5652 !This section has been created automatically by the script Abilint (TD). 5653 !Do not modify the following lines by hand. 5654 #undef ABI_FUNC 5655 #define ABI_FUNC 'pawdij_print_dij' 5656 !End of the abilint section 5657 5658 implicit none 5659 5660 !Arguments ------------------------------------ 5661 !scalars 5662 integer,intent(in) :: cplex_dij,cplex_rf,iatom,natom,nspden,nsppol 5663 integer,optional,intent(in) :: Ha_or_eV,opt_prtvol,unit 5664 real(dp),intent(in),optional :: test_value 5665 character(len=4),optional,intent(in) :: mode_paral 5666 character(len=100),optional,intent(in) :: title_msg 5667 !arrays 5668 real(dp),intent(in),target :: dij(:,:) 5669 5670 !Local variables------------------------------- 5671 character(len=7),parameter :: dspin(6)=(/"up ","down ","up-up ","dwn-dwn","up-dwn ","dwn-up "/) 5672 integer :: idij,idij_sym,kk,lmn_size,lmn2_size,my_idij,my_idij_sym 5673 integer :: my_prtvol,my_unt,my_Ha_or_eV,ndij,tmp_cplex_dij 5674 real(dp) :: my_test_value,test_value_eff 5675 character(len=4) :: my_mode 5676 character(len=2000) :: msg 5677 !arrays 5678 integer :: idum(0) 5679 real(dp),allocatable,target :: dij1(:),dij2(:) 5680 real(dp),pointer :: dij2p(:),dij2p_(:) 5681 5682 ! ************************************************************************* 5683 5684 !Optional arguments 5685 my_unt =std_out ; if (PRESENT(unit )) my_unt =unit 5686 my_mode ='COLL' ; if (PRESENT(mode_paral)) my_mode =mode_paral 5687 my_prtvol=1 ; if (PRESENT(opt_prtvol)) my_prtvol=opt_prtvol 5688 my_test_value=-one; if (PRESENT(test_value)) my_test_value=test_value 5689 my_Ha_or_eV=1 ; if (PRESENT(Ha_or_eV)) my_Ha_or_eV=Ha_or_eV 5690 5691 !Title 5692 if (present(title_msg)) then 5693 if (trim(title_msg)/='') then 5694 write(msg, '(2a)') ch10,trim(title_msg) 5695 call wrtout(my_unt,msg,my_mode) 5696 end if 5697 end if 5698 5699 !Inits 5700 ndij=size(dij,2) 5701 lmn2_size=size(dij,1)/(cplex_rf*cplex_dij) 5702 lmn_size=int(dsqrt(two*dble(lmn2_size))) 5703 if (cplex_rf==2) then 5704 LIBPAW_ALLOCATE(dij1,(2*lmn2_size)) 5705 LIBPAW_ALLOCATE(dij2,(2*lmn2_size)) 5706 end if 5707 5708 ! === Loop over Dij components === 5709 do idij=1,ndij 5710 5711 idij_sym=idij;if (ndij==4.and.idij>2) idij_sym=7-idij 5712 5713 !Subtitle 5714 if (natom>1.or.nspden>1.or.ndij==4) then 5715 if (nspden==1.and.ndij/=4) write(msg,'(a,i3)') ' Atom #',iatom 5716 if (nspden==2) write(msg,'(a,i3,a,i1)')' Atom #',iatom,' - Spin component ',idij 5717 if (ndij==4) write(msg,'(a,i3,2a)') ' Atom #',iatom,' - Component ',trim(dspin(idij+2*(ndij/4))) 5718 call wrtout(my_unt,msg,my_mode) 5719 end if 5720 5721 !Select upper and lower triangular parts 5722 my_idij=min(size(dij,2),idij) 5723 my_idij_sym=min(size(dij,2),idij_sym) 5724 if (cplex_rf==1) then 5725 tmp_cplex_dij=cplex_dij 5726 dij2p => dij(1:cplex_dij*lmn2_size:1,my_idij) 5727 dij2p_ => dij(1:cplex_dij*lmn2_size:1,my_idij_sym) 5728 else 5729 tmp_cplex_dij=2 5730 if (cplex_dij==1) then 5731 do kk=1,lmn2_size 5732 dij1(2*kk-1)= dij(kk,my_idij) 5733 dij1(2*kk )= dij(kk+lmn2_size,my_idij) 5734 dij2(2*kk-1)= dij(kk,my_idij_sym) 5735 dij2(2*kk )=-dij(kk+lmn2_size,my_idij_sym) 5736 end do 5737 else 5738 do kk=1,lmn2_size 5739 dij1(2*kk-1)= dij(2*kk-1,idij)-dij(2*kk +2*lmn2_size,my_idij) 5740 dij1(2*kk )= dij(2*kk ,idij)+dij(2*kk-1+2*lmn2_size,my_idij) 5741 dij2(2*kk-1)= dij(2*kk-1,idij_sym)+dij(2*kk +2*lmn2_size,my_idij_sym) 5742 dij2(2*kk )= dij(2*kk ,idij_sym)-dij(2*kk-1+2*lmn2_size,my_idij_sym) 5743 end do 5744 end if 5745 dij2p => dij1 ; dij2p_ => dij2 5746 end if 5747 5748 !Printing 5749 test_value_eff=-one;if(my_test_value>zero.and.idij==1) test_value_eff=my_test_value 5750 call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,& 5751 & my_prtvol,idum,test_value_eff,my_Ha_or_eV,& 5752 & opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode) 5753 5754 end do !idij 5755 5756 if (cplex_rf==2) then 5757 LIBPAW_DEALLOCATE(dij1) 5758 LIBPAW_DEALLOCATE(dij2) 5759 end if 5760 5761 end subroutine pawdij_print_dij
m_pawdij/pawdijexxc [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdijexxc
FUNCTION
Compute the local Exact-Exchange contribution to the PAW pseudopotential strength Dij, using a potential expressed as (l,m) spherical moments (for one atom only; only for correlated electrons): D_ij^EXXC= < Phi_i|alpha*(VFock(correlated)-Vxc(n1_correlated)|Phi_j>
INPUTS
cplex_rf=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX cplex_dij=1 if dij is REAL, 2 if complex (2 for spin-orbit) lmselect(lm_size)=select the non-zero LM-moments of on-site potentials ndij= number of spin components nsppol=number of independent spin WF components pawang <type(pawang_type)>=paw angular mesh and related data pawrad <type(pawrad_type)>=paw radial mesh and related data, for current atom pawtab <type(pawtab_type)>=paw tabulated starting data, for current atom vpawx(1,lmn2_size,ndij)=moments of exact exchange potential for current atom and for correlated electrons vxc_ex(cplex_rf*mesh_size,lm_size,nspden)=all-electron on-site XC potential for current atom taken into account only valence correlated electrons
OUTPUT
dijexxc(cplex_dij*lmn2_size,ndij)= D_ij^XC terms
NOTES
cplex_rf is for RF, cplex_dij is for non-collinear (nspinor==2)
PARENTS
m_pawdij
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
3165 subroutine pawdijexxc(cplex_rf,cplex_dij,dijexxc,lmselect,ndij,nspden,nsppol,& 3166 & pawang,pawrad,pawtab,vpawx,vxc_ex) 3167 3168 3169 !This section has been created automatically by the script Abilint (TD). 3170 !Do not modify the following lines by hand. 3171 #undef ABI_FUNC 3172 #define ABI_FUNC 'pawdijexxc' 3173 !End of the abilint section 3174 3175 implicit none 3176 3177 !Arguments --------------------------------------------- 3178 !scalars 3179 integer,intent(in) :: cplex_rf,cplex_dij,ndij,nspden,nsppol 3180 type(pawang_type),intent(in) :: pawang 3181 !arrays 3182 logical :: lmselect(:) 3183 real(dp),intent(in) :: vpawx(:,:,:),vxc_ex(:,:,:) 3184 real(dp),intent(out) :: dijexxc(:,:) 3185 type(pawrad_type),intent(in) :: pawrad 3186 type(pawtab_type),intent(in) :: pawtab 3187 3188 !Local variables --------------------------------------- 3189 !scalars 3190 integer :: icount,idij,idijend,ij_size,iln,in1,in2,ir,ir1,isel,ispden,ivxc 3191 integer :: jln,j0ln,klm,klm1,klmn,klmn1,klmn2,kln,lexexch,ln_min,ln_max,lmax,lmin 3192 integer :: lm_size,lmn2_size,mesh_size,nsploop 3193 character(len=500) :: msg 3194 !arrays 3195 real(dp),allocatable :: dijexxc_idij(:),ff(:),gg(:),vxcij1(:) 3196 3197 ! ************************************************************************* 3198 3199 !Useful data 3200 lm_size=pawtab%lcut_size**2 3201 lmn2_size=pawtab%lmn2_size 3202 ij_size=pawtab%ij_size 3203 mesh_size=pawtab%mesh_size 3204 lexexch=pawtab%lexexch 3205 ln_min=pawtab%lnproju(1) 3206 ln_max=pawtab%lnproju(pawtab%nproju) 3207 3208 !Check data consistency 3209 if (cplex_rf==2) then 3210 msg='pawdijexx not yet available for cplex_rf=2!' 3211 MSG_BUG(msg) 3212 end if 3213 if (size(dijexxc,1)/=cplex_dij*lmn2_size.or.size(dijexxc,2)/=ndij) then 3214 msg='invalid sizes for dijexxc!' 3215 MSG_BUG(msg) 3216 end if 3217 if (size(lmselect)/=lm_size) then 3218 msg='invalid size for lmselect!' 3219 MSG_BUG(msg) 3220 end if 3221 if (size(vxc_ex,1)/=cplex_rf*mesh_size.or.size(vxc_ex,2)/=lm_size.or.& 3222 & size(vxc_ex,3)/=nspden) then 3223 msg='invalid sizes for vxc_ex!' 3224 MSG_BUG(msg) 3225 end if 3226 if (size(vpawx,1)/=1.or.size(vpawx,2)/=lmn2_size.or.& 3227 & size(vpawx,3)/=ndij) then 3228 msg='invalid sizes for vpawx!' 3229 MSG_BUG(msg) 3230 end if 3231 3232 !Init memory 3233 dijexxc=zero 3234 LIBPAW_ALLOCATE(dijexxc_idij,(cplex_rf*lmn2_size)) 3235 LIBPAW_ALLOCATE(vxcij1,(cplex_rf*ij_size)) 3236 LIBPAW_ALLOCATE(ff,(mesh_size)) 3237 LIBPAW_ALLOCATE(gg,(mesh_size)) 3238 3239 !---------------------------------------------------------- 3240 !Loop over spin components 3241 !---------------------------------------------------------- 3242 nsploop=nsppol;if (ndij==4) nsploop=4 3243 do idij=1,nsploop 3244 3245 if (idij<=nsppol.or.(ndij==4.and.idij<=3)) then 3246 3247 idijend=idij+idij/3 3248 do ispden=idij,idijend 3249 3250 dijexxc_idij=zero 3251 3252 ivxc=ispden 3253 !Take into account nspden=1/nspinor=2 case 3254 if (ndij/=nspden.and.ispden==2) ivxc=1 3255 if (ndij/=nspden.and.ispden> 2) cycle 3256 3257 ! ---------------------------------------------------------- 3258 ! Summing over (l,m) moments 3259 ! ---------------------------------------------------------- 3260 do klm=1,lm_size 3261 if (lmselect(klm)) then 3262 3263 ! ===== Vxc_ij_1 (tmp) ===== 3264 vxcij1=zero 3265 if (cplex_rf==1) then 3266 do jln=ln_min,ln_max 3267 j0ln=jln*(jln-1)/2 3268 do iln=ln_min,jln 3269 kln=j0ln+iln 3270 ff(1:mesh_size)= & 3271 & vxc_ex(1:mesh_size,klm,ivxc)*pawtab%phiphj(1:mesh_size,kln) 3272 call simp_gen(vxcij1(kln),ff,pawrad) 3273 end do 3274 end do 3275 else 3276 do jln=ln_min,ln_max 3277 j0ln=jln*(jln-1)/2 3278 do iln=ln_min,jln 3279 kln=j0ln+iln 3280 do ir=1,mesh_size 3281 ir1=2*ir 3282 ff(ir)= & 3283 & vxc_ex(ir1-1,klm,ivxc)*pawtab%phiphj(ir,kln) 3284 gg(ir)= & 3285 & vxc_ex(ir1,klm,ivxc)*pawtab%phiphj(ir,kln) 3286 end do 3287 call simp_gen(vxcij1(2*kln-1),ff,pawrad) 3288 call simp_gen(vxcij1(2*kln ),gg,pawrad) 3289 end do 3290 end do 3291 end if 3292 3293 ! ===== Accumulate Vxc_ij_1 over klm moments ===== 3294 if (cplex_rf==1) then 3295 do klmn=1,lmn2_size 3296 lmin=pawtab%indklmn(3,klmn) 3297 lmax=pawtab%indklmn(4,klmn) 3298 if (lmin==0.and.lmax==2*lexexch) then 3299 klm1=pawtab%indklmn(1,klmn) 3300 kln=pawtab%indklmn(2,klmn) 3301 isel=pawang%gntselect(klm,klm1) 3302 if (isel>0) dijexxc_idij(klmn)=dijexxc_idij(klmn) & 3303 & +vxcij1(kln)*pawang%realgnt(isel) 3304 end if 3305 end do ! Loop klmn 3306 else ! cplex_rf==2 3307 klmn1=1 3308 do klmn=1,lmn2_size 3309 lmin=pawtab%indklmn(3,klmn) 3310 lmax=pawtab%indklmn(4,klmn) 3311 if (lmin==0.and.lmax==2*lexexch) then 3312 klm1=pawtab%indklmn(1,klmn) 3313 kln=pawtab%indklmn(2,klmn) 3314 isel=pawang%gntselect(klm,klm1) 3315 if (isel>0) then 3316 dijexxc_idij(klmn1 )=dijexxc_idij(klmn1) & 3317 & +vxcij1(2*kln-1)*pawang%realgnt(isel) 3318 dijexxc_idij(klmn1+1)=dijexxc_idij(klmn1+1) & 3319 & +vxcij1(2*kln )*pawang%realgnt(isel) 3320 end if 3321 end if 3322 klmn1=klmn1+cplex_rf 3323 end do ! Loop klmn 3324 end if 3325 3326 end if ! lmselect 3327 end do ! Loop klm 3328 3329 ! Mix Hartree and GGA terms 3330 if (cplex_rf==1) then 3331 do klmn=1,lmn2_size 3332 lmin=pawtab%indklmn(3,klmn) 3333 lmax=pawtab%indklmn(4,klmn) 3334 if (lmin==0.and.lmax==2*lexexch) then 3335 in1=pawtab%klmntomn(3,klmn) 3336 in2=pawtab%klmntomn(4,klmn) 3337 icount=in1+(in2*(in2-1))/2 3338 if(pawtab%ij_proj<icount) then 3339 msg='PAW local exact-exchange: Problem while computing dijexxc !' 3340 MSG_BUG(msg) 3341 end if 3342 dijexxc_idij(klmn)=pawtab%exchmix & 3343 & *(vpawx(1,klmn,idij)-dijexxc_idij(klmn)) 3344 end if 3345 end do 3346 else ! cplex_rf=2 3347 klmn1=1 3348 do klmn=1,lmn2_size 3349 lmin=pawtab%indklmn(3,klmn) 3350 lmax=pawtab%indklmn(4,klmn) 3351 if (lmin==0.and.lmax==2*lexexch) then 3352 in1=pawtab%klmntomn(3,klmn) 3353 in2=pawtab%klmntomn(4,klmn) 3354 icount=in1+(in2*(in2-1))/2 3355 if(pawtab%ij_proj<icount) then 3356 msg='PAW local exact-exchange: Problem while computing dijexxc !' 3357 MSG_BUG(msg) 3358 end if 3359 dijexxc_idij(klmn1) =pawtab%exchmix & 3360 & *(vpawx(1,klmn,idij)-dijexxc_idij(klmn1)) 3361 dijexxc_idij(klmn1+1)=pawtab%exchmix & 3362 & *(vpawx(1,klmn,idij)-dijexxc_idij(klmn1+1)) 3363 end if 3364 klmn1=klmn1+cplex_rf 3365 end do ! Loop klmn 3366 end if 3367 3368 ! ---------------------------------------------------------- 3369 ! Deduce some part of Dij according to symmetries 3370 ! ---------------------------------------------------------- 3371 3372 !if ispden=1 => real part of D^11_ij 3373 !if ispden=2 => real part of D^22_ij 3374 !if ispden=3 => real part of D^12_ij 3375 !if ispden=4 => imaginary part of D^12_ij 3376 klmn1=max(1,ispden-2);klmn2=1 3377 do klmn=1,lmn2_size 3378 dijexxc(klmn1,idij)=dijexxc_idij(klmn2) 3379 klmn1=klmn1+cplex_dij 3380 klmn2=klmn2+cplex_rf 3381 end do 3382 if (cplex_rf==2) then 3383 !Same storage with exp^(-i.q.r) phase 3384 klmn1=max(1,ispden-2)+lmn2_size*cplex_dij;klmn2=2 3385 do klmn=1,lmn2_size 3386 dijexxc(klmn1,idij)=dijexxc_idij(klmn2) 3387 klmn1=klmn1+cplex_dij 3388 klmn2=klmn2+cplex_rf 3389 end do 3390 endif 3391 3392 end do !ispden 3393 3394 !Non-collinear: D_ij(:,4)=Re[i.D^21_ij]=-Im[D^12_ij] 3395 else if (nspden==4.and.idij==4) then 3396 dijexxc(:,idij)=dijexxc(:,idij-1) 3397 if (cplex_dij==2) then 3398 do klmn=2,lmn2_size*cplex_dij,cplex_dij 3399 dijexxc(klmn,idij)=-dijexxc(klmn,idij) 3400 end do 3401 if (cplex_rf==2) then 3402 do klmn=2+lmn2_size*cplex_dij,2*lmn2_size*cplex_dij,cplex_dij 3403 dijexxc(klmn,idij)=-dijexxc(klmn,idij) 3404 end do 3405 end if 3406 end if 3407 3408 !Antiferro: D_ij(:,2)=D^down_ij=D^up_ij 3409 else if (nsppol==1.and.idij==2) then 3410 dijexxc(:,idij)=dijexxc(:,idij-1) 3411 end if 3412 3413 !---------------------------------------------------------- 3414 !End loop on spin density components 3415 end do 3416 3417 !Free temporary memory spaces 3418 LIBPAW_DEALLOCATE(dijexxc_idij) 3419 LIBPAW_DEALLOCATE(vxcij1) 3420 LIBPAW_DEALLOCATE(ff) 3421 LIBPAW_DEALLOCATE(gg) 3422 3423 end subroutine pawdijexxc
m_pawdij/pawdijfock [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdijfock
FUNCTION
Compute Fock exact-exchange contribution(s) to the PAW pseudopotential strength Dij (for one atom only)
INPUTS
cplex_rf=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX cplex_dij=1 if dij is REAL, 2 if complex (2 for spin-orbit) [hyb_mixing, hyb_mixing_sr]= -- optional-- mixing factors for the global (resp. screened) XC hybrid functional ndij= number of spin components nspden=number of spin density components pawrhoij <type(pawrhoij_type)>= paw rhoij occupancies (and related data) for current atom pawtab <type(pawtab_type)>=paw tabulated starting data, for current atom cplex=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX lmselect(lm_size)=select the non-zero LM-moments of on-site potentials nspden=number of spin density components nsppol=number of independent spin WF components pawang <type(pawang_type)>=paw angular mesh and related data pawrad <type(pawrad_type)>=paw radial mesh and related data, for current atom pawtab <type(pawtab_type)>=paw tabulated starting data, for current atom
OUTPUT
dijfock_vv(cplex_dij*lmn2_size,ndij)= D_ij^fock terms for valence-valence interactions dijfock_cv(cplex_dij*lmn2_size,ndij)= D_ij^fock terms for core-valence interactions
PARENTS
m_pawdij,pawdenpot
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
1517 subroutine pawdijfock(cplex_rf,cplex_dij,dijfock_vv,dijfock_cv,hyb_mixing,hyb_mixing_sr,ndij,nspden,nsppol,pawrhoij,pawtab) 1518 1519 1520 !This section has been created automatically by the script Abilint (TD). 1521 !Do not modify the following lines by hand. 1522 #undef ABI_FUNC 1523 #define ABI_FUNC 'pawdijfock' 1524 !End of the abilint section 1525 1526 implicit none 1527 1528 !Arguments --------------------------------------------- 1529 !scalars 1530 integer,intent(in) :: cplex_rf,cplex_dij,ndij,nspden,nsppol 1531 real(dp),intent(in) :: hyb_mixing,hyb_mixing_sr 1532 !arrays 1533 real(dp),intent(out) :: dijfock_vv(:,:),dijfock_cv(:,:) 1534 type(pawrhoij_type),intent(in) :: pawrhoij 1535 type(pawtab_type),intent(in),target :: pawtab 1536 1537 !Local variables --------------------------------------- 1538 !scalars 1539 integer :: cplex_rhoij,idij,idijend,ispden,irhoij,jrhoij,ilmn_i,jlmn_j,ilmn_k,jlmn_l 1540 integer :: klmn_kl,klmn_ij,klmn_il,klmn_kj,klmn,klmn1,klmn2,nsploop,lmn2_size 1541 1542 character(len=500) :: msg 1543 !arrays 1544 real(dp) :: ro(cplex_dij) 1545 real(dp),allocatable :: dijfock_idij_vv(:),dijfock_idij_cv(:) 1546 real(dp),pointer :: eijkl(:,:) 1547 1548 ! ************************************************************************* 1549 1550 !Useful data 1551 lmn2_size=pawtab%lmn2_size 1552 cplex_rhoij=pawrhoij%cplex 1553 1554 !Check data consistency 1555 if (cplex_rf==2) then 1556 msg='pawdijfock not compatible with cplex_rf=2!' 1557 MSG_BUG(msg) 1558 end if 1559 if (cplex_dij<cplex_rhoij) then 1560 msg='cplex_dij must be >= cplex_rhoij!' 1561 MSG_BUG(msg) 1562 end if 1563 if (size(dijfock_vv,1)/=cplex_dij*lmn2_size.or.size(dijfock_vv,2)/=ndij) then 1564 msg='invalid sizes for Dijfock_vv!' 1565 MSG_BUG(msg) 1566 end if 1567 if (size(dijfock_cv,1)/=cplex_dij*lmn2_size.or.size(dijfock_cv,2)/=ndij) then 1568 msg='invalid sizes for Dijfock_cv!' 1569 MSG_BUG(msg) 1570 end if 1571 1572 if (abs(hyb_mixing)>tol8 .and. abs(hyb_mixing_sr)>tol8) then 1573 msg='invalid hybrid functional' 1574 MSG_BUG(msg) 1575 else 1576 if (abs(hyb_mixing)>tol8) then 1577 eijkl => pawtab%eijkl 1578 else if (abs(hyb_mixing_sr)>tol8) then 1579 eijkl => pawtab%eijkl_sr 1580 end if 1581 end if 1582 1583 !Init memory 1584 dijfock_vv=zero ; dijfock_cv=zero 1585 LIBPAW_ALLOCATE(dijfock_idij_vv,(cplex_dij*lmn2_size)) 1586 LIBPAW_ALLOCATE(dijfock_idij_cv,(cplex_dij*lmn2_size)) 1587 1588 !---------------------------------------------------------- 1589 !Loop over spin components 1590 !---------------------------------------------------------- 1591 nsploop=nsppol;if (ndij==4) nsploop=4 1592 do idij=1,nsploop 1593 if (idij<=nsppol.or.(nspden==4.and.idij<=3).or.(cplex_dij==2.and.idij<=nspden)) then 1594 1595 idijend=idij+idij/3;if (cplex_dij==2) idijend=idij 1596 do ispden=idij,idijend 1597 1598 !!!! WARNING : What follows has been tested only for cases where nsppol=1 and 2, nspden=1 and 2 with nspinor=1. 1599 dijfock_idij_vv=zero 1600 dijfock_idij_cv=zero 1601 !Real on-site quantities (ground-state calculation) 1602 if (cplex_dij==1) then 1603 !* Loop on the non-zero elements rho_kl 1604 do irhoij=1,pawrhoij%nrhoijsel 1605 klmn_kl=pawrhoij%rhoijselect(irhoij) 1606 ro(1)=pawrhoij%rhoijp(irhoij,ispden)*pawtab%dltij(klmn_kl) 1607 ilmn_k=pawtab%indklmn(7,klmn_kl) 1608 jlmn_l=pawtab%indklmn(8,klmn_kl) 1609 !* Fock contribution to the element (k,l) of dijfock 1610 dijfock_idij_vv(klmn_kl)=dijfock_idij_vv(klmn_kl)-ro(1)*eijkl(klmn_kl,klmn_kl) 1611 !* Fock contribution to the element (i,j) of dijfock with (i,j) < (k,l) 1612 !* We remind that i<j and k<l by construction 1613 do klmn_ij=1,klmn_kl-1 1614 ilmn_i=pawtab%indklmn(7,klmn_ij) 1615 jlmn_j=pawtab%indklmn(8,klmn_ij) 1616 !* In this case, i < l 1617 klmn_il=jlmn_l*(jlmn_l-1)/2+ilmn_i 1618 !* If k >j, one must consider the index of the symmetric element (j,k) ; otherwise, the index of the element (k,j) is calculated. 1619 if (ilmn_k>jlmn_j) then 1620 klmn_kj=ilmn_k*(ilmn_k-1)/2+jlmn_j 1621 else 1622 klmn_kj=jlmn_j*(jlmn_j-1)/2+ilmn_k 1623 end if 1624 !* In this case, (i,l) >= (k,j) 1625 dijfock_idij_vv(klmn_ij)=dijfock_idij_vv(klmn_ij)-ro(1)*eijkl(klmn_il,klmn_kj) 1626 end do 1627 !* Fock contribution to the element (i,j) of dijfock with (i,j) > (k,l) 1628 !* We remind that i<j and k<l by construction 1629 do klmn_ij=klmn_kl+1,lmn2_size 1630 ilmn_i=pawtab%indklmn(7,klmn_ij) 1631 jlmn_j=pawtab%indklmn(8,klmn_ij) 1632 !* In this case, k < j 1633 klmn_kj=jlmn_j*(jlmn_j-1)/2+ilmn_k 1634 !* If i >l, one must consider the index of the symmetric element (l,i) ; otherwise, the index of the element (i,l) is calculated. 1635 if (ilmn_i>jlmn_l) then 1636 klmn_il=ilmn_i*(ilmn_i-1)/2+jlmn_l 1637 else 1638 klmn_il=jlmn_l*(jlmn_l-1)/2+ilmn_i 1639 end if 1640 !* In this case, (k,j) >= (i,l) 1641 dijfock_idij_vv(klmn_ij)=dijfock_idij_vv(klmn_ij)-ro(1)*eijkl(klmn_kj,klmn_il) 1642 end do 1643 end do 1644 ! Add the core-valence contribution 1645 do klmn_ij=1,lmn2_size 1646 dijfock_idij_cv(klmn_ij)=dijfock_idij_cv(klmn_ij)+pawtab%ex_cvij(klmn_ij) 1647 end do 1648 1649 !Complex on-site quantities 1650 else !cplex_dij=2 1651 jrhoij=1 1652 !* Loop on the non-zero elements rho_kl 1653 do irhoij=1,pawrhoij%nrhoijsel 1654 klmn_kl=pawrhoij%rhoijselect(irhoij) 1655 ro(1)=pawrhoij%rhoijp(jrhoij,ispden)*pawtab%dltij(klmn_kl) 1656 ro(2)=pawrhoij%rhoijp(jrhoij+1,ispden)*pawtab%dltij(klmn_kl) 1657 ilmn_k=pawtab%indklmn(7,klmn_kl) 1658 jlmn_l=pawtab%indklmn(8,klmn_kl) 1659 !* Fock contribution to the element (k,l) of dijfock 1660 dijfock_idij_vv(klmn_kl)=dijfock_idij_vv(klmn_kl)-ro(1)*eijkl(klmn_kl,klmn_kl) 1661 dijfock_idij_vv(klmn_kl+1)=dijfock_idij_vv(klmn_kl)-ro(2)*eijkl(klmn_kl,klmn_kl) 1662 !* Fock contribution to the element (i,j) of dijfock with (i,j) < (k,l) 1663 !* We remind that i<j and k<l by construction 1664 do klmn_ij=1,klmn_kl-1 1665 ilmn_i=pawtab%indklmn(7,klmn_ij) 1666 jlmn_j=pawtab%indklmn(8,klmn_ij) 1667 !* In this case, i < l 1668 klmn_il=jlmn_l*(jlmn_l-1)/2+ilmn_i 1669 !* If k >j, one must consider the index of the symmetric element (j,k) ; otherwise, the index of the element (k,j) is calculated. 1670 if (ilmn_k>jlmn_j) then 1671 klmn_kj=ilmn_k*(ilmn_k-1)/2+jlmn_j 1672 else 1673 klmn_kj=jlmn_j*(jlmn_j-1)/2+ilmn_k 1674 end if 1675 !* In this case, (i,l) >= (k,j) 1676 dijfock_idij_vv(klmn_ij)=dijfock_idij_vv(klmn_ij)-ro(1)*eijkl(klmn_il,klmn_kj) 1677 dijfock_idij_vv(klmn_ij+1)=dijfock_idij_vv(klmn_ij)-ro(2)*eijkl(klmn_il,klmn_kj) 1678 end do 1679 !* Fock contribution to the element (i,j) of dijfock with (i,j) > (k,l) 1680 !* We remind that i<j and k<l by construction 1681 do klmn_ij=klmn_kl+1,lmn2_size 1682 ilmn_i=pawtab%indklmn(7,klmn_ij) 1683 jlmn_j=pawtab%indklmn(8,klmn_ij) 1684 !* In this case, k < j 1685 klmn_kj=jlmn_j*(jlmn_j-1)/2+ilmn_k 1686 !* If i >l, one must consider the index of the symmetric element (l,i) ; otherwise, the index of the element (i,l) is calculated. 1687 if (ilmn_i>jlmn_l) then 1688 klmn_kj=ilmn_i*(ilmn_i-1)/2+jlmn_l 1689 else 1690 klmn_kj=jlmn_l*(jlmn_l-1)/2+ilmn_i 1691 end if 1692 !* In this case, (k,j) >= (i,l) 1693 dijfock_idij_vv(klmn_ij)=dijfock_idij_vv(klmn_ij)-ro(1)*eijkl(klmn_kj,klmn_il) 1694 dijfock_idij_vv(klmn_ij+1)=dijfock_idij_vv(klmn_ij)-ro(2)*eijkl(klmn_kj,klmn_il) 1695 end do 1696 1697 jrhoij=jrhoij+cplex_rhoij 1698 end do 1699 ! Add the core-valence contribution 1700 do klmn_ij=1,lmn2_size,2 1701 dijfock_idij_cv(klmn_ij)=dijfock_idij_cv(klmn_ij)+pawtab%ex_cvij(klmn_ij) 1702 end do 1703 1704 end if 1705 1706 ! ---------------------------------------------------------- 1707 ! Deduce some part of Dij according to symmetries 1708 ! ---------------------------------------------------------- 1709 1710 !if ispden=1 => real part of D^11_ij 1711 !if ispden=2 => real part of D^22_ij 1712 !if ispden=3 => real part of D^12_ij 1713 !if ispden=4 => imaginary part of D^12_ij 1714 klmn1=max(1,ispden-2);klmn2=1 1715 do klmn=1,lmn2_size 1716 dijfock_vv(klmn1,idij)=dijfock_idij_vv(klmn2) 1717 dijfock_cv(klmn1,idij)=dijfock_idij_cv(klmn2) 1718 klmn1=klmn1+cplex_dij 1719 klmn2=klmn2+cplex_rf 1720 end do 1721 if (cplex_rf==2) then 1722 !Same storage with exp^(-i.q.r) phase 1723 klmn1=max(1,ispden-2)+lmn2_size*cplex_dij;klmn2=2 1724 do klmn=1,lmn2_size 1725 dijfock_vv(klmn1,idij)=dijfock_idij_vv(klmn2) 1726 dijfock_cv(klmn1,idij)=dijfock_idij_cv(klmn2) 1727 klmn1=klmn1+cplex_dij 1728 klmn2=klmn2+cplex_rf 1729 end do 1730 endif 1731 1732 end do !ispden 1733 1734 !Non-collinear: D_ij(:,4)=Re[i.D^21_ij]=-Im[D^12_ij] 1735 else if (nspden==4.and.idij==4) then 1736 dijfock_vv(:,idij)=dijfock_vv(:,idij-1) 1737 dijfock_cv(:,idij)=dijfock_cv(:,idij-1) 1738 if (cplex_dij==2) then 1739 do klmn=2,lmn2_size*cplex_dij,cplex_dij 1740 dijfock_vv(klmn,idij)=-dijfock_vv(klmn,idij) 1741 dijfock_cv(klmn,idij)=-dijfock_cv(klmn,idij) 1742 end do 1743 if (cplex_rf==2) then 1744 do klmn=2+lmn2_size*cplex_dij,2*lmn2_size*cplex_dij,cplex_dij 1745 dijfock_vv(klmn,idij)=-dijfock_vv(klmn,idij) 1746 dijfock_cv(klmn,idij)=-dijfock_cv(klmn,idij) 1747 end do 1748 end if 1749 end if 1750 1751 !Antiferro: D_ij(:,2)=D^down_ij=D^up_ij 1752 else if (nsppol==1.and.idij==2) then 1753 dijfock_vv(:,idij)=dijfock_vv(:,idij-1) 1754 dijfock_cv(:,idij)=dijfock_cv(:,idij-1) 1755 end if 1756 1757 !---------------------------------------------------------- 1758 !End loop on spin density components 1759 end do 1760 1761 if (abs(hyb_mixing)>tol8) then 1762 dijfock_vv(:,:) = hyb_mixing*dijfock_vv(:,:) 1763 else if (abs(hyb_mixing_sr)>tol8) then 1764 dijfock_vv(:,:) = hyb_mixing_sr*dijfock_vv(:,:) 1765 end if 1766 dijfock_cv(:,:) = (hyb_mixing+hyb_mixing_sr)*dijfock_cv(:,:) 1767 1768 !Free temporary memory spaces 1769 LIBPAW_DEALLOCATE(dijfock_idij_vv) 1770 LIBPAW_DEALLOCATE(dijfock_idij_cv) 1771 1772 end subroutine pawdijfock
m_pawdij/pawdijfr [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdijfr
FUNCTION
PAW, Response Function only:
Compute frozen part of psp strength Dij due to 1st-order compensation density
and first order local potential:
Dijfr =Int_R^3{vtrial*Sum_LM[Q_ij_q^LM^(1)] + Vloc^(1)*Sum_LM[Q_ij_q^LM]}
Depends on q wave vector but not on first-order wave-function.
INPUTS
cplex_rf: if 1, real space 1-order functions on FFT grid are REAL; if 2, COMPLEX gprimd(3,3)=dimensional primitive translations for reciprocal space idir=direction of atomic displacement (in case of phonons perturb.) ipert=nindex of perturbation mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc comm_atom=--optional-- MPI communicator over atoms mpi_comm_grid=--optional-- MPI communicator over real space grid components my_natom=number of atoms treated by current processor natom=total number of atoms in cell nfft=(effective) number of FFT grid points (for this processor) nspden=number of spin-density components nsppol=number of independent spin WF components ntypat=number of types of atoms option=0: computes full frozen part of Dij 1: computes frozen part of Dij without contribution from Vpsp1 pawang <type(pawang_type)>=paw angular mesh and related data pawfgrtab(my_natom) <type(pawfgrtab_type)>=atomic data given on fine rectangular grid pawrad(ntypat*usepaw) <type(pawrad_type)>=paw radial mesh and related data pawtab(ntypat) <type(pawtab_type)>=paw tabulated starting data qphon(3)=wavevector of the phonon rprimd(3,3)=dimensional primitive translations for real space ucvol=unit cell volume (bohr^3) vpsp1(cplex_rf*nfft)= first-order change of local potential vtrial(nfft,nspden)= total GS potential vxc(nfft,nspden)=XC potential xred(3,my_natom)= reduced atomic coordinates
OUTPUT
paw_ij1(iatom)%dijfr(cplex_rf*cplex_dij*lmn2_size,nspden)=
frozen contribution to psp strength Dij
=Int_R^3{vtrial*Sum_LM[Q_ij_q^LM^(1)] + Vloc^(1)*Sum_LM[Q_ij_q^LM]}
PARENTS
d2frnl,dfpt_nstpaw,dfpt_rhofermi,dfpt_scfcv
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
3481 subroutine pawdijfr(cplex_rf,gprimd,idir,ipert,my_natom,natom,nfft,ngfft,nspden,nsppol,ntypat,& 3482 & option,paw_ij1,pawang,pawfgrtab,pawrad,pawtab,qphon,rprimd,ucvol,vpsp1,vtrial,vxc,xred,& 3483 & mpi_atmtab,comm_atom,mpi_comm_grid) ! optional arguments (parallelism) 3484 3485 3486 !This section has been created automatically by the script Abilint (TD). 3487 !Do not modify the following lines by hand. 3488 #undef ABI_FUNC 3489 #define ABI_FUNC 'pawdijfr' 3490 !End of the abilint section 3491 3492 implicit none 3493 3494 !Arguments ------------------------------------ 3495 !scalars 3496 integer,intent(in) :: cplex_rf,idir,ipert,my_natom,natom,nfft,nspden,nsppol,ntypat,option 3497 integer,optional,intent(in) :: comm_atom,mpi_comm_grid 3498 real(dp),intent(in) :: ucvol 3499 type(pawang_type),intent(in) :: pawang 3500 !arrays 3501 integer,intent(in) :: ngfft(18) 3502 integer,optional,target,intent(in) :: mpi_atmtab(:) 3503 real(dp),intent(in) :: gprimd(3,3),qphon(3),rprimd(3,3) 3504 real(dp),intent(in) :: vpsp1(cplex_rf*nfft),vtrial(nfft,nspden),vxc(nfft,nspden) 3505 real(dp),intent(in) :: xred(3,natom) 3506 type(paw_ij_type),intent(inout) :: paw_ij1(my_natom) 3507 type(pawfgrtab_type),intent(inout) :: pawfgrtab(my_natom) 3508 type(pawrad_type),intent(in) :: pawrad(ntypat) 3509 type(pawtab_type),intent(in) :: pawtab(ntypat) 3510 3511 !Local variables------------------------------- 3512 !scalars 3513 integer :: cplex_dij,cplex_nspden,dplex_nsp,dplex_rf,iatom,iatom_tot,ic,idij,idijend,ier,ils,ilslm,isel 3514 integer :: ispden,istr,itypat,jc,klm,klmn,klmn1,klmn2,kln,lm_size,lmn2_size,lm0,lmax,lmin,mesh_size 3515 integer :: mm,my_comm_atom,my_comm_grid,mu,mua,mub,ndij,nfftot,nfgd,nsploop 3516 integer :: optgr0,optgr1,optgr2,usexcnhat 3517 logical :: has_phase,my_atmtab_allocated,need_dijfr_1,need_dijfr_2,need_dijfr_3,need_dijfr_4 3518 logical :: paral_atom,qne0,testdij1,testdij2,testdij3 3519 real(dp) :: c1,fact,intg,rg1 3520 character(len=500) :: msg 3521 !arrays 3522 integer,parameter :: m_index(3)=(/1,-1,0/) 3523 integer,pointer :: my_atmtab(:) 3524 integer,parameter :: alpha(9)=(/1,2,3,3,3,2,2,1,1/),beta(9)=(/1,2,3,2,1,1,3,3,2/) 3525 real(dp) :: contrib(2) 3526 real(dp),allocatable :: ff(:),intv(:,:),intv1(:,:),intv2(:,:),intvloc(:,:),intv_tmp(:,:) 3527 real(dp),allocatable :: rg(:),vloc(:,:) 3528 3529 ! ************************************************************************* 3530 3531 !Nothing to be done for DDK 3532 if (ipert==natom+1.or.ipert==natom+10) return 3533 3534 !Set up parallelism over atoms 3535 paral_atom=(present(comm_atom).and.(my_natom/=natom)) 3536 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 3537 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 3538 my_comm_grid=xmpi_comm_self;if (present(mpi_comm_grid)) my_comm_grid=mpi_comm_grid 3539 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom) 3540 3541 !Compatibility tests 3542 qne0=(qphon(1)**2+qphon(2)**2+qphon(3)**2>=1.d-15) 3543 if (my_natom>0) then 3544 if (paw_ij1(1)%cplex_rf/=cplex_rf) then 3545 msg='paw_ij1()%cplex_rf and cplex_rf must be equal !' 3546 MSG_BUG(msg) 3547 end if 3548 if (paw_ij1(1)%has_dijfr==0) then 3549 msg='pawdij1()%dijfr must be allocated !' 3550 MSG_BUG(msg) 3551 end if 3552 testdij1=(ipert<=natom.and.option==0.and.pawfgrtab(1)%gylm_allocated==0) 3553 testdij2=(ipert<=natom.and.pawfgrtab(1)%gylmgr_allocated==0) 3554 testdij3=(testdij2.and.qne0.and.pawfgrtab(1)%expiqr_allocated==0) 3555 if ((testdij1.or.testdij2.or.testdij3).and.pawfgrtab(1)%rfgd_allocated==0) then 3556 msg='pawfgrtab()%rfgd array must be allocated !' 3557 MSG_BUG(msg) 3558 end if 3559 end if 3560 3561 !Get correct index of strain pertubation 3562 if (ipert==natom+3) istr = idir 3563 if (ipert==natom+4) istr = idir + 3 3564 3565 !Some inits 3566 usexcnhat=maxval(pawtab(1:ntypat)%usexcnhat) 3567 nfftot=ngfft(1)*ngfft(2)*ngfft(3) 3568 fact=ucvol/dble(nfftot) 3569 cplex_nspden=merge(1,2,nspden/=4) 3570 dplex_nsp=cplex_nspden-1 3571 dplex_rf=cplex_rf-1 3572 3573 !Loops over atoms 3574 do iatom=1,my_natom 3575 iatom_tot=iatom;if (paral_atom) iatom_tot=my_atmtab(iatom) 3576 3577 ! Select which part of Dijfr to compute 3578 need_dijfr_1=(ipert==iatom_tot.and.paw_ij1(iatom)%has_dijfr==1) 3579 need_dijfr_2=(ipert<=natom.and.paw_ij1(iatom)%has_dijfr==1.and.(option==0)) 3580 need_dijfr_3=((ipert==natom+2.or.ipert==natom+11).and.paw_ij1(iatom)%has_dijfr==1) 3581 need_dijfr_4=((ipert==natom+3.or.ipert==natom+4).and.paw_ij1(iatom)%has_dijfr==1) 3582 3583 if ((.not.need_dijfr_1).and.(.not.need_dijfr_2).and.(.not.need_dijfr_3).and.(.not.need_dijfr_4)) then 3584 if (paw_ij1(iatom)%has_dijfr>0) then 3585 paw_ij1(iatom)%dijfr=zero ; paw_ij1(iatom)%has_dijfr=2 3586 end if 3587 cycle 3588 end if 3589 3590 ! Some atom-dependent quantities 3591 itypat=pawfgrtab(iatom)%itypat 3592 lm_size=pawtab(itypat)%lcut_size**2 3593 lmn2_size=pawtab(itypat)%lmn2_size 3594 cplex_dij=paw_ij1(iatom)%cplex_dij 3595 ndij=paw_ij1(iatom)%ndij 3596 3597 ! Eventually compute g_l(r).Y_lm(r) factors for the current atom (if not already done) 3598 nfgd=0 3599 if (need_dijfr_1.or.need_dijfr_2.or.need_dijfr_4) then 3600 nfgd=pawfgrtab(iatom)%nfgd 3601 if (((need_dijfr_2.or.need_dijfr_4).and.(pawfgrtab(iatom)%gylm_allocated==0)).or.& 3602 & ((need_dijfr_1).and.(pawfgrtab(iatom)%gylmgr_allocated==0))) then 3603 optgr0=0;optgr1=0;optgr2=0 3604 if ((need_dijfr_2.or. need_dijfr_4).and.(pawfgrtab(iatom)%gylm_allocated==0)) then 3605 if (allocated(pawfgrtab(iatom)%gylm)) then 3606 LIBPAW_DEALLOCATE(pawfgrtab(iatom)%gylm) 3607 end if 3608 LIBPAW_ALLOCATE(pawfgrtab(iatom)%gylm,(nfgd,lm_size)) 3609 pawfgrtab(iatom)%gylm_allocated=2;optgr0=1 3610 end if 3611 if ((need_dijfr_1.or.need_dijfr_4).and.(pawfgrtab(iatom)%gylmgr_allocated==0)) then 3612 if (allocated(pawfgrtab(iatom)%gylmgr)) then 3613 LIBPAW_DEALLOCATE(pawfgrtab(iatom)%gylmgr) 3614 end if 3615 LIBPAW_ALLOCATE(pawfgrtab(iatom)%gylmgr,(3,nfgd,lm_size)) 3616 pawfgrtab(iatom)%gylmgr_allocated=2;optgr1=1 3617 end if 3618 if (optgr0+optgr1+optgr2>0) then 3619 call pawgylm(pawfgrtab(iatom)%gylm,pawfgrtab(iatom)%gylmgr,pawfgrtab(iatom)%gylmgr2,& 3620 & lm_size,nfgd,optgr0,optgr1,optgr2,pawtab(itypat),pawfgrtab(iatom)%rfgd) 3621 end if 3622 end if 3623 end if 3624 3625 ! Eventually compute exp(-i.q.r) factors for the current atom (if not already done) 3626 has_phase=.false. 3627 if (need_dijfr_2) then 3628 if (qne0.and.(pawfgrtab(iatom)%expiqr_allocated==0)) then 3629 if (allocated(pawfgrtab(iatom)%expiqr)) then 3630 LIBPAW_DEALLOCATE(pawfgrtab(iatom)%expiqr) 3631 end if 3632 LIBPAW_ALLOCATE(pawfgrtab(iatom)%expiqr,(2,nfgd)) 3633 call pawexpiqr(pawfgrtab(iatom)%expiqr,gprimd,nfgd,qphon,& 3634 & pawfgrtab(iatom)%rfgd,xred(:,iatom_tot)) 3635 pawfgrtab(iatom)%expiqr_allocated=2 3636 end if 3637 has_phase=(pawfgrtab(iatom)%expiqr_allocated/=0) 3638 end if 3639 3640 ! Loop over spin components 3641 nsploop=nsppol;if (ndij==4) nsploop=4 3642 do idij=1,nsploop 3643 if (idij<=nsppol.or.(nspden==4.and.idij<=3)) then 3644 3645 idijend=idij+idij/3 3646 do ispden=idij,idijend 3647 3648 LIBPAW_ALLOCATE(intv,(cplex_rf*cplex_nspden,lm_size)) 3649 intv(:,:) = zero 3650 3651 ! ============ Phonons ==================================== 3652 if (ipert<=natom) then 3653 3654 if (need_dijfr_1.or.need_dijfr_2) then 3655 3656 LIBPAW_ALLOCATE(intv1,(cplex_nspden,lm_size)) 3657 LIBPAW_ALLOCATE(intv2,(cplex_rf,lm_size)) 3658 intv1(:,:)=zero ; intv2(:,:)=zero 3659 3660 ! First part: Int_R^3{vtrial*Sum_LM[Q_ij_q^LM^(1)]} 3661 if (need_dijfr_1) then 3662 3663 ! ----- Retrieve potential Vlocal (subtle if nspden=4 ;-) 3664 LIBPAW_ALLOCATE(vloc,(cplex_nspden,nfgd)) 3665 if (nspden/=4) then 3666 if (usexcnhat==0) then 3667 do ic=1,nfgd 3668 jc=pawfgrtab(iatom)%ifftsph(ic) 3669 vloc(1,ic)=vtrial(jc,ispden)-vxc(jc,ispden) 3670 end do 3671 else 3672 do ic=1,nfgd 3673 vloc(1,ic)=vtrial(pawfgrtab(iatom)%ifftsph(ic),ispden) 3674 end do 3675 end if 3676 else ! nspden==4 3677 if (ispden<=2) then 3678 if (usexcnhat==0) then 3679 do ic=1,nfgd 3680 jc=pawfgrtab(iatom)%ifftsph(ic) 3681 vloc(1,ic)=vtrial(jc,ispden)-vxc(jc,ispden) 3682 vloc(2,ic)=zero 3683 end do 3684 else 3685 do ic=1,nfgd 3686 jc=pawfgrtab(iatom)%ifftsph(ic) 3687 vloc(1,ic)=vtrial(jc,ispden) 3688 vloc(2,ic)=zero 3689 end do 3690 end if 3691 else if (ispden==3) then 3692 if (usexcnhat==0) then 3693 vloc(:,:)=zero 3694 else 3695 do ic=1,nfgd 3696 jc=pawfgrtab(iatom)%ifftsph(ic) 3697 vloc(1,ic)=vtrial(jc,3) 3698 vloc(2,ic)=vtrial(jc,4) 3699 end do 3700 end if 3701 else ! ispden=4 3702 vloc(2,1:nfgd)=-vloc(2,1:nfgd) 3703 end if 3704 end if 3705 3706 ! ----- Compute Integral [ Vtrial(r).(g_l(r).Y_lm(r))^(1) dr ] 3707 LIBPAW_ALLOCATE(intv_tmp,(cplex_nspden,3)) 3708 do ilslm=1,lm_size 3709 intv_tmp=zero 3710 do ic=1,nfgd 3711 do mu=1,3 3712 ! Minus sign because dg(r-R)/dR = -dg(r-R)/dr 3713 contrib(1:cplex_nspden)=-vloc(1:cplex_nspden,ic)*pawfgrtab(iatom)%gylmgr(mu,ic,ilslm) 3714 intv_tmp(1:cplex_nspden,mu)=intv_tmp(1:cplex_nspden,mu)+contrib(1:cplex_nspden) 3715 end do 3716 end do 3717 ! Convert from cartesian to reduced coordinates 3718 intv1(1:cplex_nspden,ilslm)=intv1(1:cplex_nspden,ilslm) & 3719 & +(rprimd(1,idir)*intv_tmp(1:cplex_nspden,1) & 3720 & +rprimd(2,idir)*intv_tmp(1:cplex_nspden,2) & 3721 & +rprimd(3,idir)*intv_tmp(1:cplex_nspden,3)) 3722 end do 3723 LIBPAW_DEALLOCATE(vloc) 3724 LIBPAW_DEALLOCATE(intv_tmp) 3725 end if ! need_dijfr_1 3726 3727 ! 2nd part: Int_R^3{Vloc^(1)*Sum_LM[Q_ij_q^LM]} 3728 if (need_dijfr_2) then 3729 3730 if (ispden==1) then 3731 3732 ! ----- Retrieve potential Vloc^(1) 3733 LIBPAW_ALLOCATE(vloc,(cplex_rf,nfgd)) 3734 do ic=1,nfgd 3735 jc=cplex_rf*pawfgrtab(iatom)%ifftsph(ic)-dplex_rf 3736 vloc(1:cplex_rf,ic)=vpsp1(jc:jc+dplex_rf) 3737 end do 3738 3739 ! ----- Compute Integral [ Vloc^(1)(r).g_l(r).Y_lm(r) ] 3740 LIBPAW_ALLOCATE(intvloc,(cplex_rf,lm_size)) 3741 intvloc=zero 3742 if (has_phase) then 3743 if (cplex_rf==1) then 3744 do ilslm=1,lm_size 3745 do ic=1,nfgd 3746 contrib(1)=vloc(1,ic)*pawfgrtab(iatom)%gylm(ic,ilslm) 3747 intvloc(1,ilslm)=intvloc(1,ilslm)+contrib(1)*pawfgrtab(iatom)%expiqr(1,ic) 3748 end do 3749 end do 3750 else 3751 do ilslm=1,lm_size 3752 do ic=1,nfgd 3753 contrib(1:2)=vloc(1:2,ic)*pawfgrtab(iatom)%gylm(ic,ilslm) 3754 intvloc(1,ilslm)=intvloc(1,ilslm)+contrib(1)*pawfgrtab(iatom)%expiqr(1,ic) & 3755 & -contrib(2)*pawfgrtab(iatom)%expiqr(2,ic) 3756 intvloc(2,ilslm)=intvloc(2,ilslm)+contrib(1)*pawfgrtab(iatom)%expiqr(2,ic) & 3757 & +contrib(2)*pawfgrtab(iatom)%expiqr(1,ic) 3758 end do 3759 end do 3760 end if 3761 else ! no phase 3762 do ilslm=1,lm_size 3763 do ic=1,nfgd 3764 contrib(1:cplex_rf)=vloc(1:cplex_rf,ic)*pawfgrtab(iatom)%gylm(ic,ilslm) 3765 intvloc(1:cplex_rf,ilslm)=intvloc(1:cplex_rf,ilslm)+contrib(1:cplex_rf) 3766 end do 3767 end do 3768 end if 3769 LIBPAW_DEALLOCATE(vloc) 3770 end if ! ispden=1 3771 3772 !Add to previous contribution 3773 if (ispden<=min(nspden,2)) then 3774 intv2(1:cplex_rf,1:lm_size)=intv2(1:cplex_rf,1:lm_size)+intvloc(1:cplex_rf,1:lm_size) 3775 if (ispden==min(nspden,2)) then 3776 LIBPAW_DEALLOCATE(intvloc) 3777 end if 3778 end if 3779 end if ! need_dijfr_2 3780 3781 ! Sum contributions and apply ucvol/nfft factor on integral 3782 intv(1:cplex_nspden,1:lm_size)=intv1(1:cplex_nspden,1:lm_size) 3783 intv(1,1:lm_size)=intv(1,1:lm_size)+intv2(1,1:lm_size) 3784 if (cplex_rf==2) intv(cplex_nspden+1,1:lm_size)=intv(cplex_nspden+1,1:lm_size)+intv2(2,1:lm_size) 3785 intv(:,:)=fact*intv(:,:) 3786 LIBPAW_DEALLOCATE(intv1) 3787 LIBPAW_DEALLOCATE(intv2) 3788 3789 ! --- Reduction in case of parallelization --- 3790 call xmpi_sum(intv,my_comm_grid,ier) 3791 3792 paw_ij1(iatom)%dijfr(:,ispden)=zero 3793 3794 ! ---- Loop over (i,j) components 3795 klmn1=1;klmn2=1+lmn2_size*cplex_dij 3796 do klmn=1,lmn2_size 3797 klm =pawtab(itypat)%indklmn(1,klmn) 3798 lmin=pawtab(itypat)%indklmn(3,klmn) 3799 lmax=pawtab(itypat)%indklmn(4,klmn) 3800 do ils=lmin,lmax,2 3801 lm0=ils**2+ils+1 3802 do mm=-ils,ils 3803 ilslm=lm0+mm;isel=pawang%gntselect(lm0+mm,klm) 3804 if (isel>0) then 3805 !The following works only because cplex_nspden<=cplex_dij 3806 paw_ij1(iatom)%dijfr(klmn1:klmn1+dplex_nsp,ispden)= & 3807 & paw_ij1(iatom)%dijfr(klmn1:klmn1+dplex_nsp,ispden) & 3808 & +pawtab(itypat)%qijl(ilslm,klmn)*intv(1:cplex_nspden,ilslm) 3809 if (cplex_rf==2) then 3810 paw_ij1(iatom)%dijfr(klmn2:klmn2+dplex_nsp,ispden)= & 3811 & paw_ij1(iatom)%dijfr(klmn2:klmn2+dplex_nsp,ispden) & 3812 & +pawtab(itypat)%qijl(ilslm,klmn)*intv(1+cplex_nspden:2*cplex_nspden,ilslm) 3813 end if 3814 end if 3815 end do 3816 end do 3817 klmn1=klmn1+cplex_dij;klmn2=klmn2+cplex_dij 3818 end do 3819 3820 ! Dijfr is marked as computed 3821 paw_ij1(iatom)%has_dijfr=2 3822 3823 end if 3824 3825 ! ============ Electric field perturbation ======================= 3826 else if (ipert==natom+2.or.ipert==natom+11) then 3827 3828 if (need_dijfr_3) then 3829 3830 ! The following factor arises in expanding the angular dependence of the dipole 3831 ! vector in terms of real spherical harmonics. The real spherical harmonics are as 3832 ! in the routine initylmr.F90; 3833 ! see http://www.unioviedo.es/qcg/art/Theochem419-19-ov-BF97-rotation-matrices.pdf 3834 c1 = sqrt(four_pi/three) 3835 mesh_size=pawtab(itypat)%mesh_size 3836 3837 if (ispden==1) then 3838 3839 LIBPAW_ALLOCATE(ff,(mesh_size)) 3840 LIBPAW_ALLOCATE(rg,(3)) 3841 3842 ! loop over basis state pairs for this atom 3843 klmn1=1 3844 do klmn = 1, paw_ij1(iatom)%lmn2_size 3845 klm =pawtab(itypat)%indklmn(1,klmn) 3846 kln =pawtab(itypat)%indklmn(2,klmn) 3847 lmin=pawtab(itypat)%indklmn(3,klmn) 3848 lmax=pawtab(itypat)%indklmn(4,klmn) 3849 3850 ! Select only l=1, because the dipole is a vector operator 3851 if (lmin==1) then 3852 lm0=3 ! (l^2+l+1) for l=1 3853 3854 ! Computation of <phi_i|r|phi_j>- <tphi_i|r|tphi_j> 3855 ! the dipole vector has radial dependence r 3856 ff(1:mesh_size)=(pawtab(itypat)%phiphj(1:mesh_size,kln)& 3857 & -pawtab(itypat)%tphitphj(1:mesh_size,kln))& 3858 & *pawrad(itypat)%rad(1:mesh_size) 3859 ! call pawrad_deducer0(ff,mesh_size,pawrad(itypat)) 3860 call simp_gen(intg,ff,pawrad(itypat)) 3861 3862 ! Compute <S_li_mi|r-R|S_lj_mj>: use a real Gaunt expression (with selection rule) 3863 rg(1:3)=zero 3864 do ic=1,3 3865 isel=pawang%gntselect(lm0+m_index(ic),klm) 3866 if (isel>0) rg(ic)=pawang%realgnt(isel) 3867 end do 3868 3869 ! Translate from cartesian to reduced coordinates (in idir direction) 3870 rg1=gprimd(1,idir)*rg(1)+gprimd(2,idir)*rg(2)+gprimd(3,idir)*rg(3) 3871 3872 ! Build sqrt(4pi/3).<S_li_mi|r-R|S_lj_mj>.(<phi_i|r-R|phi_j>- <tphi_i|r-R|tphi_j> 3873 paw_ij1(iatom)%dijfr(klmn1,ispden)=c1*rg1*intg 3874 if (cplex_dij==2) paw_ij1(iatom)%dijfr(klmn1+1,ispden)=zero 3875 3876 else 3877 paw_ij1(iatom)%dijfr(klmn1,ispden)=zero 3878 end if ! end gaunt constraint 3879 3880 klmn1=klmn1+cplex_dij 3881 end do ! end loop over lmn2_size pairs of basis states 3882 LIBPAW_DEALLOCATE(ff) 3883 LIBPAW_DEALLOCATE(rg) 3884 3885 ! Dijfr is spin-independent for electric field case 3886 else if (ispden==2) then 3887 paw_ij1(iatom)%dijfr(:,ispden)=paw_ij1(iatom)%dijfr(:,1) 3888 else 3889 paw_ij1(iatom)%dijfr(:,ispden)=zero 3890 end if 3891 3892 ! Dijfr is marked as computed 3893 paw_ij1(iatom)%has_dijfr=2 3894 end if 3895 3896 ! ============ Elastic tensor =============================== 3897 else if (ipert==natom+3.or.ipert==natom+4) then 3898 3899 ! ----- Retrieve potential Vlocal (subtle if nspden=4 ;-) 3900 LIBPAW_ALLOCATE(vloc,(cplex_nspden,nfgd)) 3901 if (nspden/=4) then 3902 if (usexcnhat==0) then 3903 do ic=1,nfgd 3904 jc=pawfgrtab(iatom)%ifftsph(ic) 3905 vloc(1,ic)=vtrial(jc,ispden)-vxc(jc,ispden) 3906 end do 3907 else 3908 do ic=1,nfgd 3909 vloc(1,ic)=vtrial(pawfgrtab(iatom)%ifftsph(ic),ispden) 3910 end do 3911 end if 3912 else ! nspden/=4 3913 if (ispden<=2) then 3914 if (usexcnhat==0) then 3915 do ic=1,nfgd 3916 jc=pawfgrtab(iatom)%ifftsph(ic) 3917 vloc(1,ic)=vtrial(jc,ispden)-vxc(jc,ispden) 3918 vloc(2,ic)=zero 3919 end do 3920 else 3921 do ic=1,nfgd 3922 jc=pawfgrtab(iatom)%ifftsph(ic) 3923 vloc(1,ic)=vtrial(jc,ispden) 3924 vloc(2,ic)=zero 3925 end do 3926 end if 3927 else if (ispden==3) then 3928 if (usexcnhat==0) then 3929 vloc(:,:)=zero 3930 else 3931 do ic=1,nfgd 3932 jc=pawfgrtab(iatom)%ifftsph(ic) 3933 vloc(1,ic)=vtrial(jc,3) 3934 vloc(2,ic)=vtrial(jc,4) 3935 end do 3936 end if 3937 else ! ispden=4 3938 vloc(2,1:nfgd)=-vloc(2,1:nfgd) 3939 end if 3940 end if 3941 3942 ! option = 0 Insulator case 3943 if(option==0)then 3944 do ilslm=1,lm_size 3945 do ic=1,nfgd 3946 jc=pawfgrtab(iatom)%ifftsph(ic) 3947 contrib(1:cplex_nspden) = zero 3948 3949 ! Int_R^3{vtrial*Sum_LM[Q_ij_q^LM^(1)]} 3950 mua=alpha(istr);mub=beta(istr) 3951 contrib(1:cplex_nspden)=contrib(1:cplex_nspden)+half*vloc(1:cplex_nspden,ic)& 3952 & *(pawfgrtab(iatom)%gylmgr(mua,ic,ilslm)*pawfgrtab(iatom)%rfgd(mub,ic)& 3953 & + pawfgrtab(iatom)%gylmgr(mub,ic,ilslm)*pawfgrtab(iatom)%rfgd(mua,ic)) 3954 3955 ! Int_R^3{Vloc^(1)*Sum_LM[Q_ij_q^LM]} 3956 contrib(1)=contrib(1)+vpsp1(jc)*pawfgrtab(iatom)%gylm(ic,ilslm) 3957 3958 ! delta_{alphabeta}Int_R^3{Vloc*Sum_LM[Q_ij_q^LM]} 3959 if(istr<=3)then 3960 contrib(1:cplex_nspden)=contrib(1:cplex_nspden) & 3961 & +vloc(1:cplex_nspden,ic)*pawfgrtab(iatom)%gylm(ic,ilslm) 3962 end if 3963 3964 intv(1:cplex_nspden,ilslm)=intv(1:cplex_nspden,ilslm)+contrib(1:cplex_nspden) 3965 end do 3966 end do 3967 3968 ! option = 1 Metal case (without Vpsp1) 3969 else if (option==1)then 3970 do ilslm=1,lm_size 3971 do ic=1,nfgd 3972 jc=pawfgrtab(iatom)%ifftsph(ic) 3973 contrib(1) = zero 3974 3975 ! Int_R^3{vtrial*Sum_LM[Q_ij_q^LM^(1)]} 3976 mua=alpha(istr);mub=beta(istr) 3977 contrib(1:cplex_nspden)=contrib(1:cplex_nspden)+half*vloc(1:cplex_nspden,ic)& 3978 & *(pawfgrtab(iatom)%gylmgr(mua,ic,ilslm)*pawfgrtab(iatom)%rfgd(mub,ic)& 3979 & + pawfgrtab(iatom)%gylmgr(mub,ic,ilslm)*pawfgrtab(iatom)%rfgd(mua,ic)) 3980 3981 ! delta_{alphabeta}Int_R^3{Vtrial*Sum_LM[Q_ij_q^LM]} 3982 if(istr<=3)then 3983 contrib(1:cplex_nspden)=contrib(1:cplex_nspden) & 3984 & +vloc(1:cplex_nspden,ic)*pawfgrtab(iatom)%gylm(ic,ilslm) 3985 end if 3986 3987 intv(1:cplex_nspden,ilslm)=intv(1:cplex_nspden,ilslm)+contrib(1:cplex_nspden) 3988 end do 3989 end do 3990 end if 3991 LIBPAW_DEALLOCATE(vloc) 3992 3993 ! Apply ucvol/nfft factor on integral 3994 intv(:,:)=fact*intv(:,:) 3995 3996 ! --- Reduction in case of parallelization --- 3997 call xmpi_sum(intv,my_comm_grid,ier) 3998 3999 paw_ij1(iatom)%dijfr(:,ispden)=zero 4000 4001 ! ---- Loop over (i,j) components 4002 klmn1=1 4003 do klmn=1,lmn2_size 4004 klm =pawtab(itypat)%indklmn(1,klmn) 4005 lmin=pawtab(itypat)%indklmn(3,klmn) 4006 lmax=pawtab(itypat)%indklmn(4,klmn) 4007 do ils=lmin,lmax,2 4008 lm0=ils**2+ils+1 4009 do mm=-ils,ils 4010 ilslm=lm0+mm;isel=pawang%gntselect(lm0+mm,klm) 4011 if (isel>0) then 4012 !The following works only because cplex_nspden<=cplex_dij 4013 paw_ij1(iatom)%dijfr(klmn1:klmn1+dplex_nsp,ispden)= & 4014 & paw_ij1(iatom)%dijfr(klmn1:klmn1+dplex_nsp,ispden) & 4015 & +pawtab(itypat)%qijl(ilslm,klmn)*intv(1:cplex_nspden,ilslm) 4016 end if 4017 end do 4018 end do 4019 klmn1=klmn1+cplex_dij 4020 end do 4021 4022 ! Dijfr is marked as computed 4023 paw_ij1(iatom)%has_dijfr=2 4024 4025 end if ! ipert 4026 4027 LIBPAW_DEALLOCATE(intv) 4028 4029 !---------------------------------------------------------- 4030 ! End loops over spin components 4031 end do ! ispden 4032 4033 ! ---------------------------------------------------------- 4034 ! Deduce some part of Dij according to symmetries 4035 ! ---------------------------------------------------------- 4036 4037 !Non-collinear: D_ij(:,4)=Re[i.D^21_ij]=-Im[D^12_ij] 4038 else if (nspden==4.and.idij==4) then 4039 paw_ij1(iatom)%dijfr(:,idij)=paw_ij1(iatom)%dijfr(:,idij-1) 4040 if (cplex_dij==2) then 4041 do klmn=2,lmn2_size*cplex_dij,cplex_dij 4042 paw_ij1(iatom)%dijfr(klmn,idij)=-paw_ij1(iatom)%dijfr(klmn,idij) 4043 end do 4044 if (cplex_rf==2) then 4045 do klmn=2+lmn2_size*cplex_dij,2*lmn2_size*cplex_dij,cplex_dij 4046 paw_ij1(iatom)%dijfr(klmn,idij)=-paw_ij1(iatom)%dijfr(klmn,idij) 4047 end do 4048 end if 4049 end if 4050 4051 !Antiferro: D_ij(:,2)=D^down_ij=D^up_ij 4052 else if (nsppol==1.and.idij==2) then 4053 paw_ij1(iatom)%dijfr(:,idij)=paw_ij1(iatom)%dijfr(:,idij-1) 4054 end if 4055 4056 ! End loop on Dij components 4057 end do ! idij 4058 4059 !---------------------------------------------------------- 4060 4061 ! Eventually free temporary space for g_l(r).Y_lm(r) gradients and exp(-i.q.r) 4062 if (need_dijfr_1.or.need_dijfr_2) then 4063 if (pawfgrtab(iatom)%gylm_allocated==2) then 4064 LIBPAW_DEALLOCATE(pawfgrtab(iatom)%gylm) 4065 LIBPAW_ALLOCATE(pawfgrtab(iatom)%gylm,(0,0)) 4066 pawfgrtab(iatom)%gylm_allocated=0 4067 end if 4068 if (pawfgrtab(iatom)%gylmgr_allocated==2) then 4069 LIBPAW_DEALLOCATE(pawfgrtab(iatom)%gylmgr) 4070 LIBPAW_ALLOCATE(pawfgrtab(iatom)%gylmgr,(0,0,0)) 4071 pawfgrtab(iatom)%gylmgr_allocated=0 4072 end if 4073 if (pawfgrtab(iatom)%expiqr_allocated==2) then 4074 LIBPAW_DEALLOCATE(pawfgrtab(iatom)%expiqr) 4075 LIBPAW_ALLOCATE(pawfgrtab(iatom)%expiqr,(0,0)) 4076 pawfgrtab(iatom)%expiqr_allocated=0 4077 end if 4078 end if 4079 4080 ! End loop on atoms 4081 end do 4082 4083 !Destroy atom table used for parallelism 4084 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 4085 4086 end subroutine pawdijfr
m_pawdij/pawdijhartree [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdijhartree
FUNCTION
Compute the Hartree contribution to the PAW pseudopotential strength Dij (for one atom only)
INPUTS
cplex_rf=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX nspden=number of spin density components pawrhoij <type(pawrhoij_type)>= paw rhoij occupancies (and related data) for current atom pawtab <type(pawtab_type)>=paw tabulated starting data, for current atom
OUTPUT
dijxc(cplex_rf*lmn2_size)= D_ij^Hartree terms
PARENTS
m_pawdij,pawdenpot,pawdfptenergy
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
1095 subroutine pawdijhartree(cplex_rf,dijhartree,nspden,pawrhoij,pawtab) 1096 1097 1098 !This section has been created automatically by the script Abilint (TD). 1099 !Do not modify the following lines by hand. 1100 #undef ABI_FUNC 1101 #define ABI_FUNC 'pawdijhartree' 1102 !End of the abilint section 1103 1104 implicit none 1105 1106 !Arguments --------------------------------------------- 1107 !scalars 1108 integer,intent(in) :: cplex_rf,nspden 1109 !arrays 1110 real(dp),intent(out) :: dijhartree(:) 1111 type(pawrhoij_type),intent(in) :: pawrhoij 1112 type(pawtab_type),intent(in) :: pawtab 1113 1114 !Local variables --------------------------------------- 1115 !scalars 1116 integer :: cplex_rhoij,irhoij,ispden,jrhoij,kklmn,kklmn1,klmn,klmn1,lmn2_size,nspdiag 1117 character(len=500) :: msg 1118 !arrays 1119 real(dp) :: ro(2) 1120 1121 ! ************************************************************************* 1122 1123 !Useful data 1124 lmn2_size=pawtab%lmn2_size 1125 cplex_rhoij=pawrhoij%cplex 1126 nspdiag=1;if (nspden==2) nspdiag=2 1127 1128 !Check data consistency 1129 if (size(dijhartree,1)/=cplex_rf*lmn2_size) then 1130 msg='invalid size for DijHartree !' 1131 MSG_BUG(msg) 1132 end if 1133 if (cplex_rhoij<cplex_rf) then 1134 msg='cplex_rhoij must be >=cplex_rf!' 1135 MSG_BUG(msg) 1136 end if 1137 1138 !Initialization 1139 dijhartree=zero 1140 1141 do ispden=1,nspdiag 1142 jrhoij=1 1143 do irhoij=1,pawrhoij%nrhoijsel 1144 klmn=pawrhoij%rhoijselect(irhoij) 1145 ro(1:cplex_rf)=pawrhoij%rhoijp(jrhoij:jrhoij+cplex_rf-1,ispden)*pawtab%dltij(klmn) 1146 1147 dijhartree(klmn)=dijhartree(klmn)+ro(1)*pawtab%eijkl(klmn,klmn) 1148 do klmn1=1,klmn-1 1149 dijhartree(klmn1)=dijhartree(klmn1)+ro(1)*pawtab%eijkl(klmn1,klmn) 1150 end do 1151 do klmn1=klmn+1,lmn2_size 1152 dijhartree(klmn1)=dijhartree(klmn1)+ro(1)*pawtab%eijkl(klmn,klmn1) 1153 end do 1154 1155 ! If Rf calculation, Dij^Hartree has a complex phase 1156 if (cplex_rf==2) then 1157 kklmn=klmn+lmn2_size 1158 dijhartree(kklmn)=dijhartree(kklmn)+ro(2)*pawtab%eijkl(klmn,klmn) 1159 do klmn1=1,klmn-1 1160 kklmn1=klmn1+lmn2_size 1161 dijhartree(kklmn1)=dijhartree(kklmn1)+ro(2)*pawtab%eijkl(klmn1,klmn) 1162 end do 1163 do klmn1=klmn+1,lmn2_size 1164 kklmn1=klmn1+lmn2_size 1165 dijhartree(kklmn1)=dijhartree(kklmn1)+ro(2)*pawtab%eijkl(klmn,klmn1) 1166 end do 1167 end if 1168 1169 jrhoij=jrhoij+cplex_rhoij 1170 end do 1171 end do 1172 1173 end subroutine pawdijhartree
m_pawdij/pawdijhat [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdijhat
FUNCTION
Compute the "hat" contribution to the PAW pseudopotential strength Dij, i.e. the compensation charge contribution (for one atom only): D_ij^hat=Intg_R [ V(r). Sum_L(Qij^L(r)). dr]
INPUTS
cplex_rf=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX cplex_dij=1 if dij is REAL, 2 if complex (2 for spin-orbit) gprimd(3,3)=dimensional primitive translations for reciprocal space iatom=absolute index of current atom (between 1 and natom) ipert=index of perturbation; used only for RF calculation ; set ipert<=0 for GS calculations. natom=total number of atoms ndij= number of spin components ngrid=number of points of the real space grid (FFT, WVL, ...) treated by current proc ngridtot=total number of points of the real space grid (FFT, WVL, ...) For the FFT grid, thi should be equal to ngfft1*ngfft2*ngfft3 nspden=number of spin density components nsppol=number of independent spin WF components pawang <type(pawang_type)>=paw angular mesh and related data pawfgrtab<type(pawfgrtab_type)>=atomic data given on fine rectangular grid for current atom pawtab(ntypat) <type(pawtab_type)>=paw tabulated starting data, for current atom Pot(cplex_rf*ngrid,nspden)=potential on real space grid qphon(3)=(RF calculations only) - wavevector of the phonon ucvol=unit cell volume xred(3,my_natom)= reduced atomic coordinates
OUTPUT
dijhat(cplex_rf*cplex_dij*lmn2_size,ndij)= D_ij^hat terms
NOTES
cplex_rf is for RF (phase e^(-i.q.r)), cplex_dij is for non-collinear (nspinor==2)
PARENTS
fock_getghc,m_pawdij
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
2087 subroutine pawdijhat(cplex_rf,cplex_dij,dijhat,gprimd,iatom,ipert,& 2088 & natom,ndij,ngrid,ngridtot,nspden,nsppol,pawang,pawfgrtab,& 2089 & pawtab,Pot,qphon,ucvol,xred,& 2090 & mpi_comm_grid) ! Optional argument 2091 2092 2093 !This section has been created automatically by the script Abilint (TD). 2094 !Do not modify the following lines by hand. 2095 #undef ABI_FUNC 2096 #define ABI_FUNC 'pawdijhat' 2097 !End of the abilint section 2098 2099 implicit none 2100 2101 !Arguments --------------------------------------------- 2102 !scalars 2103 integer,intent(in) :: cplex_rf,cplex_dij,iatom,ipert,natom,ndij 2104 integer,intent(in) :: ngrid,ngridtot,nspden,nsppol 2105 integer,intent(in),optional :: mpi_comm_grid 2106 real(dp),intent(in) :: ucvol 2107 type(pawang_type),intent(in) :: pawang 2108 type(pawfgrtab_type),intent(inout) :: pawfgrtab 2109 !arrays 2110 real(dp),intent(in) :: gprimd(3,3),Pot(cplex_rf*ngrid,nspden),qphon(3),xred(3,natom) 2111 real(dp),intent(out) :: dijhat(:,:) 2112 type(pawtab_type),intent(in) :: pawtab 2113 2114 !Local variables --------------------------------------- 2115 !scalars 2116 integer :: ic,idij,idijend,ier,ils,ilslm,ilslm1,isel,ispden,jc,klm,klmn,klmn1,klmn2 2117 integer :: lm0,lm_size,lmax,lmin,lmn2_size,mm,my_comm_grid,nfgd,nsploop,optgr0,optgr1 2118 logical :: has_phase,qne0 2119 real(dp) :: vi,vr 2120 character(len=500) :: msg 2121 !arrays 2122 real(dp) :: rdum(1) 2123 real(dp),allocatable :: dijhat_idij(:),prod(:) 2124 2125 ! ************************************************************************* 2126 2127 !Useful data 2128 lm_size=pawtab%lcut_size**2 2129 lmn2_size=pawtab%lmn2_size 2130 nfgd=pawfgrtab%nfgd 2131 has_phase=.false. 2132 qne0=(qphon(1)**2+qphon(2)**2+qphon(3)**2>=1.d-15) 2133 my_comm_grid=xmpi_comm_self;if (present(mpi_comm_grid)) my_comm_grid=mpi_comm_grid 2134 2135 !Check data consistency 2136 if (size(dijhat,1)/=cplex_rf*cplex_dij*lmn2_size.or.size(dijhat,2)/=ndij) then 2137 msg='invalid sizes for Dijhat !' 2138 MSG_BUG(msg) 2139 end if 2140 if (pawfgrtab%rfgd_allocated==0.and.ipert>0.and.ipert<=natom.and.qne0) then 2141 msg='pawfgrtab()%rfgd array must be allocated !' 2142 MSG_BUG(msg) 2143 end if 2144 2145 !Eventually compute g_l(r).Y_lm(r) factors for the current atom (if not already done) 2146 if ((pawfgrtab%gylm_allocated==0).or.((ipert==iatom).and.(pawfgrtab%gylmgr_allocated==0))) then 2147 optgr0=0;optgr1=0 2148 if (pawfgrtab%gylm_allocated==0) then 2149 if (allocated(pawfgrtab%gylm)) then 2150 LIBPAW_DEALLOCATE(pawfgrtab%gylm) 2151 end if 2152 LIBPAW_ALLOCATE(pawfgrtab%gylm,(nfgd,lm_size)) 2153 pawfgrtab%gylm_allocated=2;optgr0=1 2154 end if 2155 if ((ipert==iatom).and.(pawfgrtab%gylmgr_allocated==0)) then 2156 if (allocated(pawfgrtab%gylmgr)) then 2157 LIBPAW_DEALLOCATE(pawfgrtab%gylmgr) 2158 end if 2159 LIBPAW_ALLOCATE(pawfgrtab%gylmgr,(3,nfgd,lm_size)) 2160 pawfgrtab%gylmgr_allocated=2;optgr1=1 2161 end if 2162 if (optgr0+optgr1>0) then 2163 call pawgylm(pawfgrtab%gylm,pawfgrtab%gylmgr,rdum,lm_size,nfgd,optgr0,optgr1,0,& 2164 & pawtab,pawfgrtab%rfgd) 2165 end if 2166 end if 2167 2168 !Eventually compute exp(i.q.r) factors for the current atom (if not already done) 2169 if ((ipert==iatom).and.qne0.and.(pawfgrtab%expiqr_allocated==0)) then 2170 if (allocated(pawfgrtab%expiqr)) then 2171 LIBPAW_DEALLOCATE(pawfgrtab%expiqr) 2172 end if 2173 LIBPAW_ALLOCATE(pawfgrtab%expiqr,(2,nfgd)) 2174 call pawexpiqr(pawfgrtab%expiqr,gprimd,nfgd,qphon,pawfgrtab%rfgd,xred(:,iatom)) 2175 pawfgrtab%expiqr_allocated=2 2176 end if 2177 has_phase=(qne0.and.ipert>0.and.pawfgrtab%expiqr_allocated/=0) 2178 2179 !Init memory 2180 dijhat=zero 2181 LIBPAW_ALLOCATE(prod,(cplex_rf*lm_size)) 2182 LIBPAW_ALLOCATE(dijhat_idij,(cplex_rf*lmn2_size)) 2183 2184 !---------------------------------------------------------- 2185 !Loop over spin components 2186 !---------------------------------------------------------- 2187 nsploop=nsppol;if (ndij==4) nsploop=4 2188 do idij=1,nsploop 2189 if (idij<=nsppol.or.(nspden==4.and.idij<=3)) then 2190 2191 idijend=idij+idij/3 2192 do ispden=idij,idijend 2193 2194 ! ------------------------------------------------------ 2195 ! Compute Int[V(r).g_l(r).Y_lm(r)] 2196 ! ------------------------------------------------------ 2197 ! Note for non-collinear magnetism: 2198 ! We compute Int[V^(alpha,beta)(r).g_l(r).Y_lm(r)] 2199 ! Remember: if nspden=4, V is stored as : V^11, V^22, V^12, i.V^21 2200 2201 prod=zero 2202 2203 ! ===== Standard case ============================ 2204 if (.not.has_phase) then 2205 if (cplex_rf==1) then 2206 do ilslm=1,lm_size 2207 do ic=1,nfgd 2208 vr=Pot(pawfgrtab%ifftsph(ic),ispden) 2209 prod(ilslm)=prod(ilslm)+vr*pawfgrtab%gylm(ic,ilslm) 2210 end do 2211 end do 2212 else 2213 ilslm1=1 2214 do ilslm=1,lm_size 2215 do ic=1,nfgd 2216 jc=2*pawfgrtab%ifftsph(ic) 2217 vr=Pot(jc-1,ispden);vi=Pot(jc,ispden) 2218 prod(ilslm1 )=prod(ilslm1 )+vr*pawfgrtab%gylm(ic,ilslm) 2219 prod(ilslm1+1)=prod(ilslm1+1)+vi*pawfgrtab%gylm(ic,ilslm) 2220 end do 2221 ilslm1=ilslm1+cplex_rf 2222 end do 2223 end if 2224 2225 ! ===== Including Exp(iqr) phase (DFPT only) ===== 2226 else 2227 if (cplex_rf==1) then 2228 do ilslm=1,lm_size 2229 do ic=1,nfgd 2230 vr=Pot(pawfgrtab%ifftsph(ic),ispden) 2231 prod(ilslm)=prod(ilslm)+vr*pawfgrtab%gylm(ic,ilslm)& 2232 & *pawfgrtab%expiqr(1,ic) 2233 end do 2234 end do 2235 else 2236 ilslm1=1 2237 do ilslm=1,lm_size 2238 do ic=1,nfgd 2239 jc=2*pawfgrtab%ifftsph(ic) 2240 vr=Pot(jc-1,ispden);vi=Pot(jc,ispden) 2241 prod(ilslm1 )=prod(ilslm1 )+pawfgrtab%gylm(ic,ilslm)& 2242 & *(vr*pawfgrtab%expiqr(1,ic)-vi*pawfgrtab%expiqr(2,ic)) 2243 prod(ilslm1+1)=prod(ilslm1+1)+pawfgrtab%gylm(ic,ilslm)& 2244 & *(vr*pawfgrtab%expiqr(2,ic)+vi*pawfgrtab%expiqr(1,ic)) 2245 end do 2246 ilslm1=ilslm1+cplex_rf 2247 end do 2248 end if 2249 end if 2250 2251 ! Scaling factor (unit volume) 2252 prod=prod*ucvol/dble(ngridtot) 2253 2254 ! Reduction in case of parallelism 2255 if (xmpi_comm_size(my_comm_grid)>1) then 2256 call xmpi_sum(prod,my_comm_grid,ier) 2257 end if 2258 2259 ! ---------------------------------------------------------- 2260 ! Compute Sum_(i,j)_LM { q_ij^L Int[V(r).g_l(r).Y_lm(r)] } 2261 ! ---------------------------------------------------------- 2262 ! Note for non-collinear magnetism: 2263 ! We compute Sum_(i,j)_LM { q_ij^L Int[V^(alpha,beta)(r).g_l(r).Y_lm(r)] } 2264 2265 dijhat_idij=zero 2266 2267 if (cplex_rf==1) then 2268 do klmn=1,lmn2_size 2269 klm =pawtab%indklmn(1,klmn) 2270 lmin=pawtab%indklmn(3,klmn) 2271 lmax=pawtab%indklmn(4,klmn) 2272 do ils=lmin,lmax,2 2273 lm0=ils**2+ils+1 2274 do mm=-ils,ils 2275 ilslm=lm0+mm;isel=pawang%gntselect(lm0+mm,klm) 2276 if (isel>0) dijhat_idij(klmn)=dijhat_idij(klmn) & 2277 & +prod(ilslm)*pawtab%qijl(ilslm,klmn) 2278 end do 2279 end do 2280 end do 2281 else 2282 do klmn=1,lmn2_size 2283 klmn1=2*klmn-1 2284 klm =pawtab%indklmn(1,klmn) 2285 lmin=pawtab%indklmn(3,klmn) 2286 lmax=pawtab%indklmn(4,klmn) 2287 do ils=lmin,lmax,2 2288 lm0=ils**2+ils+1 2289 do mm=-ils,ils 2290 ilslm=lm0+mm;ilslm1=2*ilslm;isel=pawang%gntselect(lm0+mm,klm) 2291 if (isel>0) dijhat_idij(klmn1:klmn1+1)=dijhat_idij(klmn1:klmn1+1) & 2292 & +prod(ilslm1-1:ilslm1)*pawtab%qijl(ilslm,klmn) 2293 end do 2294 end do 2295 end do 2296 end if 2297 2298 ! ---------------------------------------------------------- 2299 ! Deduce some part of Dij according to symmetries 2300 ! ---------------------------------------------------------- 2301 2302 !if ispden=1 => real part of D^11_ij 2303 !if ispden=2 => real part of D^22_ij 2304 !if ispden=3 => real part of D^12_ij 2305 !if ispden=4 => imaginary part of D^12_ij 2306 klmn1=max(1,ispden-2);klmn2=1 2307 do klmn=1,lmn2_size 2308 dijhat(klmn1,idij)=dijhat_idij(klmn2) 2309 klmn1=klmn1+cplex_dij 2310 klmn2=klmn2+cplex_rf 2311 end do 2312 if (cplex_rf==2) then 2313 !Same storage with exp^(-i.q.r) phase 2314 klmn1=max(1,ispden-2)+lmn2_size*cplex_dij;klmn2=2 2315 do klmn=1,lmn2_size 2316 dijhat(klmn1,idij)=dijhat_idij(klmn2) 2317 klmn1=klmn1+cplex_dij 2318 klmn2=klmn2+cplex_rf 2319 end do 2320 endif 2321 2322 end do !ispden 2323 2324 !Non-collinear: D_ij(:,4)=Re[i.D^21_ij]=-Im[D^12_ij] 2325 else if (nspden==4.and.idij==4) then 2326 dijhat(:,idij)=dijhat(:,idij-1) 2327 if (cplex_dij==2) then 2328 do klmn=2,lmn2_size*cplex_dij,cplex_dij 2329 dijhat(klmn,idij)=-dijhat(klmn,idij) 2330 end do 2331 if (cplex_rf==2) then 2332 do klmn=2+lmn2_size*cplex_dij,2*lmn2_size*cplex_dij,cplex_dij 2333 dijhat(klmn,idij)=-dijhat(klmn,idij) 2334 end do 2335 end if 2336 end if 2337 2338 !Antiferro: D_ij(:,2)=D^down_ij=D^up_ij 2339 else if (nsppol==1.and.idij==2) then 2340 dijhat(:,idij)=dijhat(:,idij-1) 2341 end if 2342 2343 !---------------------------------------------------------- 2344 !End loop on spin density components 2345 end do 2346 2347 !Free temporary memory spaces 2348 LIBPAW_DEALLOCATE(prod) 2349 LIBPAW_DEALLOCATE(dijhat_idij) 2350 if (pawfgrtab%gylm_allocated==2) then 2351 LIBPAW_DEALLOCATE(pawfgrtab%gylm) 2352 LIBPAW_ALLOCATE(pawfgrtab%gylm,(0,0)) 2353 pawfgrtab%gylm_allocated=0 2354 end if 2355 if (pawfgrtab%gylmgr_allocated==2) then 2356 LIBPAW_DEALLOCATE(pawfgrtab%gylmgr) 2357 LIBPAW_ALLOCATE(pawfgrtab%gylmgr,(0,0,0)) 2358 pawfgrtab%gylmgr_allocated=0 2359 end if 2360 if (pawfgrtab%expiqr_allocated==2) then 2361 LIBPAW_DEALLOCATE(pawfgrtab%expiqr) 2362 LIBPAW_ALLOCATE(pawfgrtab%expiqr,(0,0)) 2363 pawfgrtab%expiqr_allocated=0 2364 end if 2365 2366 end subroutine pawdijhat
m_pawdij/pawdijnd [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdijnd
FUNCTION
Compute the nuclear dipole contribution to the PAW pseudopotential strength Dij (for one atom only)
INPUTS
ndij= number of spin components nucdipmom(3) nuclear magnetic dipole moment for current atom pawrad <type(pawrad_type)>=paw radial mesh and related data, for current atom pawtab <type(pawtab_type)>=paw tabulated starting data, for current atom
OUTPUT
dijnd(cplex_dij*lmn2_size,ndij)= nuclear dipole moment Dij terms cplex_dij=2 must be 2
NOTES
On-site contribution of a nuclear magnetic dipole moment at $R$. Hamiltonian is $H=(1/2m_e)(p - q_e A)^2 + V$, and vector potential $A$ is $A=(\mu_0/4\pi) m\times (r-R)/|r-R|^3 = (\mu_0/4\pi) L_R\cdot m/|r-R|^3$ where $L_R$ is the on-site orbital angular momentum and $m$ is the nuclear magnetic dipole moment. For an electron (as usual), mass m_e = 1 and charge q_e = -1. Second order term in A is ignored.
PARENTS
m_pawdij,pawdenpot
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
2406 subroutine pawdijnd(cplex_dij,dijnd,ndij,nucdipmom,pawrad,pawtab) 2407 2408 2409 !This section has been created automatically by the script Abilint (TD). 2410 !Do not modify the following lines by hand. 2411 #undef ABI_FUNC 2412 #define ABI_FUNC 'pawdijnd' 2413 !End of the abilint section 2414 2415 implicit none 2416 2417 !Arguments --------------------------------------------- 2418 !scalars 2419 integer,intent(in) :: cplex_dij,ndij 2420 type(pawrad_type),intent(in) :: pawrad 2421 type(pawtab_type),target,intent(in) :: pawtab 2422 !arrays 2423 real(dp),intent(out) :: dijnd(:,:) 2424 real(dp),intent(in) :: nucdipmom(3) 2425 2426 !Local variables --------------------------------------- 2427 !scalars 2428 integer :: idir,ilmn,il,im,iln,ilm,jlmn,jl,jm,jlm,jln,j0lmn,klmn,kln,mesh_size 2429 real(dp) :: intgr3,permeability 2430 complex(dpc) :: lms 2431 logical :: ndmom 2432 !arrays 2433 integer, LIBPAW_CONTIGUOUS pointer :: indlmn(:,:) 2434 real(dp),allocatable :: ff(:) 2435 character(len=500) :: msg 2436 2437 ! ************************************************************************* 2438 2439 !Useful data 2440 indlmn => pawtab%indlmn 2441 mesh_size=pawtab%mesh_size 2442 LIBPAW_ALLOCATE(ff,(mesh_size)) 2443 2444 ! magnetic permeability mu_0/four_pi in atomic units 2445 ! this constant is also used in getghcnd.F90, if you change it here, 2446 ! change it there also for consistency 2447 permeability=5.325135453D-5 2448 2449 !Check data consistency 2450 if (cplex_dij/=2) then 2451 msg='cplex_dij must be 2 for nuclear dipole moments !' 2452 MSG_BUG(msg) 2453 end if 2454 if (size(dijnd,1)/=cplex_dij*pawtab%lmn2_size.or.size(dijnd,2)/=ndij) then 2455 msg='invalid sizes for Dijnd !' 2456 MSG_BUG(msg) 2457 end if 2458 2459 dijnd = zero 2460 ndmom=(any(abs(nucdipmom)>tol8)) 2461 2462 if (ndmom) then ! only do the computation if at least one component of nuclear dipole is nonzero 2463 2464 ! loop over basis state pairs for this type 2465 do jlmn=1,pawtab%lmn_size 2466 jl=indlmn(1,jlmn) 2467 jm=indlmn(2,jlmn) 2468 jlm=indlmn(4,jlmn) 2469 jln=indlmn(5,jlmn) 2470 j0lmn=jlmn*(jlmn-1)/2 2471 do ilmn=1,jlmn 2472 il=indlmn(1,ilmn) 2473 im=indlmn(2,ilmn) 2474 iln=indlmn(5,ilmn) 2475 ilm=indlmn(4,ilmn) 2476 klmn=j0lmn+ilmn 2477 kln = pawtab%indklmn(2,klmn) 2478 2479 ! Computation of (<phi_i|phi_j>-<tphi_i|tphi_j>)/r^3 radial integral 2480 2481 ff(2:mesh_size)=(pawtab%phiphj(2:mesh_size,kln)-& 2482 & pawtab%tphitphj(2:mesh_size,kln))/pawrad%rad(2:mesh_size)**3 2483 call pawrad_deducer0(ff,mesh_size,pawrad) 2484 call simp_gen(intgr3,ff,pawrad) 2485 2486 do idir = 1, 3 2487 2488 ! matrix element <S il im|L_idir|S jl jm> 2489 call slxyzs(il,im,idir,jl,jm,lms) 2490 2491 dijnd(2*klmn-1,1) = dijnd(2*klmn-1,1) + intgr3*dreal(lms)*nucdipmom(idir)*permeability 2492 dijnd(2*klmn,1) = dijnd(2*klmn,1) + intgr3*dimag(lms)*nucdipmom(idir)*permeability 2493 2494 end do 2495 2496 end do ! end loop over ilmn 2497 end do ! end loop over jlmn 2498 2499 ! in case of ndij > 1, note that there is no spin-flip in this term 2500 ! so therefore down-down = up-up, and up-down and down-up terms are still zero 2501 if(ndij > 1) dijnd(:,2)=dijnd(:,1) 2502 2503 end if ! end check for a nonzero nuclear dipole moment 2504 2505 LIBPAW_DEALLOCATE(ff) 2506 2507 end subroutine pawdijnd
m_pawdij/pawdijso [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdijso
FUNCTION
Compute the spin-orbit contribution to the PAW pseudopotential strength Dij (for one atom only)
INPUTS
cplex_rf=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX cplex_dij=1 if dij is REAL, 2 if complex (2 for spin-orbit) ndij= number of spin components for Dij^SO nspden=number of spin density components paw_an <type(paw_an_type)>=paw arrays given on angular mesh, for current atom pawang <type(pawang_type)>=paw angular mesh and related data pawrad <type(pawrad_type)>=paw radial mesh and related data, for current atom pawtab <type(pawtab_type)>=paw tabulated starting data, for current atom pawxcdev=Choice of XC development (0=no dev. (use of angular mesh) ; 1 or 2=dev. on moments) spnorbscl=scaling factor for spin-orbit coupling vh1(cplex_rf*mesh_size,v_size,nspden)=all-electron on-site Hartree potential for current atom only spherical moment is used vxc1(cplex_rf*mesh_size,v_size,nspden)=all-electron on-site XC potential for current atom given on a (r,theta,phi) grid (v_size=angl_size) or on (l,m) spherical moments (v_size=lm_size)
OUTPUT
dijso(cplex_rf*cplex_dij*lmn2_size,ndij)= spin-orbit Dij terms
cplex_dij=2 must be 2
dijso(:,:,1) contains Dij_SO^up-up
dijso(:,:,2) contains Dij_SO^dn-dn
dijso(:,:,3) contains Dij_SO^up-dn
dijso(:,:,4) contains Dij_SO^dn-up
NOTES
cplex_rf is for RF (phase e^(-i.q.r)), cplex_dij is for non-collinear (nspinor==2)
PARENTS
m_pawdij,pawdenpot
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
2557 subroutine pawdijso(cplex_rf,cplex_dij,dijso,ndij,nspden,& 2558 & pawang,pawrad,pawtab,pawxcdev,spnorbscl,vh1,vxc1) 2559 2560 2561 !This section has been created automatically by the script Abilint (TD). 2562 !Do not modify the following lines by hand. 2563 #undef ABI_FUNC 2564 #define ABI_FUNC 'pawdijso' 2565 !End of the abilint section 2566 2567 implicit none 2568 2569 !Arguments --------------------------------------------- 2570 !scalars 2571 integer,intent(in) :: cplex_rf,cplex_dij,ndij,nspden,pawxcdev 2572 real(dp), intent(in) :: spnorbscl 2573 type(pawang_type),intent(in) :: pawang 2574 !arrays 2575 real(dp),intent(out) :: dijso(:,:) 2576 real(dp),intent(in) :: vh1(:,:,:),vxc1(:,:,:) 2577 type(pawrad_type),intent(in) :: pawrad 2578 type(pawtab_type),target,intent(in) :: pawtab 2579 !Local variables --------------------------------------- 2580 !scalars 2581 integer :: angl_size,cplex,idij,ij_size,ilm,ipts,ispden,jlm,klm,klmn,klmn1,kln 2582 integer :: lm_size,lmn2_size,mesh_size,nsploop 2583 real(dp), parameter :: HalfFineStruct2=half/InvFineStruct**2 2584 real(dp) :: fact 2585 character(len=500) :: msg 2586 !arrays 2587 integer, pointer :: indklmn(:,:) 2588 real(dp),allocatable :: dijso_rad(:),dv1dr(:),ff(:) 2589 2590 ! ************************************************************************* 2591 2592 !Useful data 2593 lm_size=pawtab%lcut_size**2 2594 lmn2_size=pawtab%lmn2_size 2595 ij_size=pawtab%ij_size 2596 angl_size=pawang%angl_size 2597 mesh_size=pawtab%mesh_size 2598 indklmn => pawtab%indklmn 2599 cplex=1 ! DijSO exists only for GS 2600 nsploop=4 2601 2602 !Check data consistency 2603 if (cplex_rf/=1) then 2604 msg='cplex_rf=2 not yet available in pawdijso!' 2605 MSG_BUG(msg) 2606 end if 2607 if (cplex_dij/=2) then 2608 msg='cplex_dij must be 2 for spin-orbit coupling!' 2609 MSG_BUG(msg) 2610 end if 2611 if (ndij/=4) then 2612 msg='ndij must be 4 for spin-orbit coupling!' 2613 MSG_BUG(msg) 2614 end if 2615 if (pawang%use_ls_ylm==0) then 2616 msg='pawang%use_ls_ylm should be /=0!' 2617 MSG_BUG(msg) 2618 end if 2619 if (size(dijso,1)/=cplex_rf*cplex_dij*lmn2_size.or.size(dijso,2)/=ndij) then 2620 msg='invalid sizes for DijSO!' 2621 MSG_BUG(msg) 2622 end if 2623 if (size(vh1,1)/=cplex*mesh_size.or.size(vh1,2)<1.or.size(vh1,3)<1) then 2624 msg='invalid sizes for vh1!' 2625 MSG_BUG(msg) 2626 end if 2627 if (size(vxc1,1)/=cplex*mesh_size.or.size(vxc1,3)/=nspden.or.& 2628 & (size(vxc1,2)/=angl_size.and.pawxcdev==0).or.& 2629 & (size(vxc1,2)/=lm_size.and.pawxcdev/=0)) then 2630 msg='invalid sizes for vxc1!' 2631 MSG_BUG(msg) 2632 end if 2633 2634 !------------------------------------------------------------------------ 2635 !----------- Allocations and initializations 2636 !------------------------------------------------------------------------ 2637 2638 !Eventually compute <Phi_i|1/r.dV/dr|Phi_j>*alpha2/2*Y_00 (for spin-orbit) 2639 LIBPAW_ALLOCATE(dv1dr,(mesh_size)) 2640 LIBPAW_ALLOCATE(dijso_rad,(ij_size)) 2641 LIBPAW_ALLOCATE(ff,(mesh_size)) 2642 fact=one/sqrt(four_pi) ! Y_00 2643 if (pawxcdev/=0) then 2644 if (nspden==1) then 2645 ff(1:mesh_size)=vxc1(1:mesh_size,1,1) 2646 else 2647 ff(1:mesh_size)=half*(vxc1(1:mesh_size,1,1)+vxc1(1:mesh_size,1,2)) 2648 end if 2649 else 2650 ff(1:mesh_size)=zero 2651 if (nspden==1) then 2652 do ipts=1,angl_size 2653 ff(1:mesh_size)=ff(1:mesh_size) & 2654 & +vxc1(1:mesh_size,ipts,1)*pawang%angwgth(ipts) 2655 end do 2656 else 2657 do ipts=1,angl_size 2658 ff(1:mesh_size)=ff(1:mesh_size) & 2659 & +half*(vxc1(1:mesh_size,ipts,1)+vxc1(1:mesh_size,ipts,2)) & 2660 & *pawang%angwgth(ipts) 2661 end do 2662 end if 2663 ff(1:mesh_size)=sqrt(four_pi)*ff(1:mesh_size) 2664 end if 2665 ff(1:mesh_size)=fact*(ff(1:mesh_size)+vh1(1:mesh_size,1,1)) 2666 call nderiv_gen(dv1dr,ff,pawrad) 2667 dv1dr(2:mesh_size)=HalfFineStruct2*(one/(one-ff(2:mesh_size)/InvFineStruct**2)) & 2668 & *dv1dr(2:mesh_size)/pawrad%rad(2:mesh_size) 2669 call pawrad_deducer0(dv1dr,mesh_size,pawrad) 2670 do kln=1,ij_size 2671 ff(1:mesh_size)= dv1dr(1:mesh_size)*pawtab%phiphj(1:mesh_size,kln) 2672 call simp_gen(dijso_rad(kln),ff,pawrad) 2673 end do 2674 LIBPAW_DEALLOCATE(dv1dr) 2675 LIBPAW_DEALLOCATE(ff) 2676 dijso_rad(:)=spnorbscl*dijso_rad(:) 2677 2678 !------------------------------------------------------------------------ 2679 !----- Loop over density components 2680 !------------------------------------------------------------------------ 2681 do idij=1,nsploop 2682 2683 ! ------------------------------------------------------------------------ 2684 ! ----- Computation of Dij_so 2685 ! ------------------------------------------------------------------------ 2686 klmn1=1 2687 dijso(:,idij)=zero 2688 if (mod(idij,2)==1) then 2689 ispden=(1+idij)/2 2690 do klmn=1,lmn2_size 2691 if (indklmn(3,klmn)==0) then ! il==jl 2692 klm=indklmn(1,klmn);kln=indklmn(2,klmn) 2693 ilm=indklmn(5,klmn);jlm=indklmn(6,klmn) 2694 fact=dijso_rad(kln);if (ilm>jlm) fact=-fact 2695 dijso(klmn1 ,idij)=fact*pawang%ls_ylm(1,klm,ispden) 2696 dijso(klmn1+1,idij)=fact*pawang%ls_ylm(2,klm,ispden) 2697 end if 2698 klmn1=klmn1+cplex_dij 2699 end do 2700 else if (idij==2) then 2701 do klmn=1,lmn2_size 2702 if (indklmn(3,klmn)==0) then ! il==jl 2703 dijso(klmn1:klmn1+1,2)=-dijso(klmn1:klmn1+1,1) 2704 end if 2705 klmn1=klmn1+cplex_dij 2706 end do 2707 else if (idij==4) then 2708 do klmn=1,lmn2_size 2709 if (indklmn(3,klmn)==0) then ! il==jl 2710 dijso(klmn1 ,4)=-dijso(klmn1 ,3) 2711 dijso(klmn1+1,4)= dijso(klmn1+1,3) 2712 end if 2713 klmn1=klmn1+cplex_dij 2714 end do 2715 end if 2716 2717 ! ----- End loop over idij 2718 end do 2719 2720 LIBPAW_DEALLOCATE(dijso_rad) 2721 2722 end subroutine pawdijso
m_pawdij/pawdiju [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdiju
FUNCTION
Compute the LDA+U contribution to the PAW pseudopotential strength Dij, (for one atom only): Dijpawu^{\sigma}_{mi,ni,mj,nj}= \sum_{m,m'} [vpawu^{\sigma}_{m,m'}*phiphjint_{ni,nj}^{m,m'}]= [vpawu^{\sigma}_{mi,mj}*phiphjint_{ni,nj}]
INPUTS
cplex_rf=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX cplex_dij=1 if dij is REAL, 2 if complex (2 for spin-orbit) ndij= number of spin components nsppol=number of independent spin WF components pawtab <type(pawtab_type)>=paw tabulated starting data, for current atom vpawu(cplex_dij,lpawu*2+1,lpawu*2+1,ndij)=moments of LDA+U potential for current atom --- Optional arguments --- atvshift(natvshift,nsppol)=potential energy shift for lm channel & spin (current atom) fatvshift=factor that multiplies atvshift natvshift=number of atomic potential energy shifts (per atom)
OUTPUT
dijpawu(cplex_rf*cplex_dij*lmn2_size,ndij)= D_ij^XC terms
NOTES
cplex_rf is for RF (phase e^(-i.q.r)), cplex_dij is for non-collinear (nspinor==2)
PARENTS
m_pawdij
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
2764 subroutine pawdiju(cplex_rf,cplex_dij,dijpawu,ndij,nsppol,pawtab,vpawu,& 2765 & natvshift,atvshift,fatvshift) ! optional arguments 2766 2767 2768 !This section has been created automatically by the script Abilint (TD). 2769 !Do not modify the following lines by hand. 2770 #undef ABI_FUNC 2771 #define ABI_FUNC 'pawdiju' 2772 !End of the abilint section 2773 2774 implicit none 2775 2776 !Arguments --------------------------------------------- 2777 !scalars 2778 integer,intent(in) :: cplex_rf,cplex_dij,ndij,nsppol 2779 integer,intent(in),optional :: natvshift 2780 real(dp),intent(in),optional :: fatvshift 2781 !arrays 2782 real(dp),intent(out) :: dijpawu(:,:) 2783 real(dp),intent(in) :: vpawu(:,:,:,:) 2784 real(dp),intent(in),optional :: atvshift(:,:) 2785 type(pawtab_type),intent(in) :: pawtab 2786 2787 !Local variables --------------------------------------- 2788 !scalars 2789 integer :: icount,idij,idijeff,idijend,im1,im2,in1,in2,klmn,klmn1,lmax,lmin,lmn2_size 2790 integer :: lpawu,natvshift_,nsploop 2791 character(len=500) :: msg 2792 !arrays 2793 real(dp),allocatable :: coeffpawu(:),dijpawu_idij(:),dijsymU(:,:) 2794 2795 ! ************************************************************************* 2796 2797 !Useful data 2798 lpawu=pawtab%lpawu 2799 lmn2_size=pawtab%lmn2_size 2800 natvshift_=0;if (present(natvshift)) natvshift_=natvshift 2801 2802 !Check data consistency 2803 if (cplex_rf/=1) then 2804 msg='cplex_rf=2 not yet available in pawdijso!' 2805 MSG_BUG(msg) 2806 end if 2807 if (size(dijpawu,1)/=cplex_rf*cplex_dij*lmn2_size.or.size(dijpawu,2)/=ndij) then 2808 msg='invalid sizes for dijpawu !' 2809 MSG_BUG(msg) 2810 end if 2811 if (size(vpawu,1)/=cplex_dij.or.size(vpawu,2)/=2*lpawu+1.or.& 2812 & size(vpawu,3)/=2*lpawu+1.or.size(vpawu,4)/=ndij) then 2813 msg='invalid sizes for vpawu !' 2814 MSG_BUG(msg) 2815 end if 2816 if (natvshift_>0) then 2817 if ((.not.present(atvshift)).or.(.not.present(fatvshift))) then 2818 msg='when natvshift>0, atvshift and fatvshift arguments must be present !' 2819 MSG_BUG(msg) 2820 end if 2821 if (size(atvshift,1)/=natvshift.or.size(atvshift,2)/=nsppol) then 2822 msg='invalid sizes for atvshift !' 2823 MSG_BUG(msg) 2824 end if 2825 end if 2826 2827 !Init memory 2828 dijpawu=zero 2829 LIBPAW_ALLOCATE(dijpawu_idij,(cplex_dij*lmn2_size)) 2830 LIBPAW_ALLOCATE(coeffpawu,(cplex_dij)) 2831 if (ndij==4) then 2832 LIBPAW_ALLOCATE(dijsymU,(cplex_dij*lmn2_size,4)) 2833 end if 2834 2835 !Loop over spin components 2836 !---------------------------------------------------------- 2837 nsploop=nsppol;if (ndij==4) nsploop=4 2838 do idij=1,nsploop 2839 if (idij<=nsppol.or.(ndij==4.and.idij<=3)) then 2840 2841 idijend=idij+idij/3 2842 do idijeff=idij,idijend ! if ndij==4, idijeff is used to compute updn and dnup contributions 2843 2844 dijpawu_idij=zero 2845 2846 ! Loop over (l,m,n) moments 2847 ! ---------------------------------------------------------- 2848 klmn1=1 2849 do klmn=1,lmn2_size 2850 im1=pawtab%klmntomn(1,klmn) 2851 im2=pawtab%klmntomn(2,klmn) 2852 lmin=pawtab%indklmn(3,klmn) 2853 lmax=pawtab%indklmn(4,klmn) 2854 2855 ! Select l=lpawu 2856 if (lmin==0.and.lmax==2*lpawu) then 2857 2858 ! Check consistency 2859 in1=pawtab%klmntomn(3,klmn) 2860 in2=pawtab%klmntomn(4,klmn) 2861 icount=in1+(in2*(in2-1))/2 2862 if (pawtab%ij_proj<icount) then 2863 msg='LDA+U: Problem while computing dijexxc !' 2864 MSG_BUG(msg) 2865 end if 2866 2867 ! coeffpawu(:)=vpawu(:,im1,im2,idijeff) ! use real and imaginary part 2868 coeffpawu(:)=vpawu(:,im2,im1,idijeff) ! because of transposition in setnoccmmp (for the cplex_dij==2) 2869 2870 if (natvshift_/=0.and.idij<3.and.im1==im2) then 2871 coeffpawu(1)=coeffpawu(1)+fatvshift*atvshift(im1,idij) 2872 end if 2873 if (cplex_dij==1) then !cplex_dij=nspinor=1 2874 dijpawu_idij(klmn1)=pawtab%phiphjint(icount)*coeffpawu(1) ! *dtset%userra 2875 elseif (cplex_dij==2) then !cplex_dij=nspinor=2 2876 dijpawu_idij(klmn1 )=pawtab%phiphjint(icount)*coeffpawu(1) 2877 dijpawu_idij(klmn1+1)=pawtab%phiphjint(icount)*coeffpawu(2) ! spinor==2 2878 end if 2879 2880 end if ! l selection 2881 klmn1=klmn1+cplex_dij 2882 end do ! klmn 2883 2884 dijpawu(:,idij)=dijpawu_idij(:) 2885 if (ndij==4) dijsymU(:,idijeff)=dijpawu_idij(:) 2886 2887 end do ! idijeff 2888 2889 end if ! idij 2890 2891 if (ndij==4.or.cplex_dij==2) then 2892 if (idij<=2) then 2893 dijpawu(:,idij)=dijpawu(:,idij) 2894 else 2895 dijpawu(:,idij)=dijsymU(:,idij) 2896 end if 2897 end if 2898 2899 !End loop over spin components 2900 !---------------------------------------------------------- 2901 end do 2902 2903 !Free temporary memory spaces 2904 LIBPAW_DEALLOCATE(dijpawu_idij) 2905 LIBPAW_DEALLOCATE(coeffpawu) 2906 if (ndij==4) then 2907 LIBPAW_DEALLOCATE(dijsymU) 2908 end if 2909 2910 end subroutine pawdiju
m_pawdij/pawdiju_euijkl [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdiju_euijkl
FUNCTION
Compute the LDA+U contribution to the PAW pseudopotential strength Dij (for one atom only). Alternative to pawdiju using the following property: D_ij^pawu^{\sigma}_{mi,ni,mj,nj}=\sum_{k,l} [rho^{\sigma}_kl*e^U_ijkl] The routine structure is very similar to the one of pawdijhartree.
INPUTS
cplex_rf=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX cplex_dij=1 if dij is REAL, 2 if complex (2 for spin-orbit) nspden=number of spin density components pawrhoij <type(pawrhoij_type)>= paw rhoij occupancies (and related data) for current atom pawtab <type(pawtab_type)>=paw tabulated starting data, for current atom
OUTPUT
diju(cplex_rf*cplex_dij*lmn2_size,ndij)= D_ij^U terms diju_im(cplex_rf*cplex_dij*lmn2_size,ndij)=
NOTES
There are some subtleties :
Contrary to eijkl, eu_ijkl is not invariant with respect to the permutation of i <--> j or k <--> l.
So the correct expression of Dij is:
D_kl = sum_i<=j ( rho_ij eu_ijkl + (1-delta_ij) rho_ji eu_jikl )
In the following, we will use that: (according to the rules in pawpuxinit.F90)
(a) eu_ijkl + eu_jikl = eu_ijlk + eu_jilk (invariant when exchanging k <--> l)
(b) eu_ijkl - eu_jikl = - eu_ijlk + eu_jilk (change of sign when exchanging k <--> l)
and :
(c) eu_iikl = eu_iilk (if i=j, invariant when exchanging k <--> l)
(d) eu_ijkk = eu_jikk (if k=l, invariant when exchanging i <--> j)
1) If cplex=1 (ipert=0 or q=0) we have simply:
rho_ji = rho_ij^*
So:
D_kl = sum_i<=j ( rho_ij eu_ijkl + (1-delta_ij) rho_ij^* eu_jikl )
As eu_ijkl is real:
[I] : Re(D_kl) = sum_i<=j Re(rho_ij) ( eu_ijkl + (1-delta_ij) eu_jikl )
Im(D_kl) = sum_i<=j Im(rho_ij) ( eu_ijkl - (1-delta_ij) eu_jikl )
So:
Re(D_kl) = sum_i<=j Re(rho_ij) ( eu_ijlk + (1-delta_ij) eu_jilk ) = Re(D_lk) ( using (a) and (c) )
Im(D_kl) = sum_i<=j Im(rho_ij) ( eu_ijlk - (1-delta_ij) eu_jilk ) = -Im(D_lk) ( using (b) and (c) )
2) If cplex=2 (so ipert>0 and q/=0), we have:
rho_ji = rhoA_ji + rhoB_ji
where:
rhoA_ji = rhoA_ij^*
rhoB_ji = rhoB_ij
So:
D_kl = sum_i<=j ( rho_ij eu_ijkl + (1-delta_ij) (rhoA_ij^* + rhoB_ij) eu_jikl )
As eu_ijkl is real:
[Ib] : Re(D_kl) = sum_i<=j Re(rho_ij) ( eu_ijkl + (1-delta_ij) eu_jikl ) (same as [I])
[II] : Im(D_kl) = sum_i<=j Im(rhoB_ij) ( eu_ijkl + (1-delta_ij) eu_jikl )
+ sum_i<=j Im(rhoA_ij) ( eu_ijkl - (1-delta_ij) eu_jikl )
where:
Im(rhoB_ij) is stored in the imaginary part of "pawrhoij%rhoijp(:)"
Im(rhoA_ij) is stored in the array "pawrhoij%rhoijim(:)"
We note:
Im(D_kl^A) = sum_i<=j Im(rhoA_ij) ( eu_ijkl - (1-delta_ij) eu_jikl )
Im(D_kl^B) = sum_i<=j Im(rhoB_ij) ( eu_ijkl + (1-delta_ij) eu_jikl )
We still have:
Re(D_kl) = Re(D_lk)
but:
Im(D_kl^A) = -Im(D_lk^A) ( using (b) and (c) )
Im(D_kl^B) = Im(D_lk^B) ( using (a) and (c) )
PARENTS
m_pawdij,pawdenpot,pawdfptenergy
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
2992 subroutine pawdiju_euijkl(cplex_rf,cplex_dij,diju,ndij,pawrhoij,pawtab,diju_im) 2993 2994 2995 !This section has been created automatically by the script Abilint (TD). 2996 !Do not modify the following lines by hand. 2997 #undef ABI_FUNC 2998 #define ABI_FUNC 'pawdiju_euijkl' 2999 !End of the abilint section 3000 3001 implicit none 3002 3003 !Arguments --------------------------------------------- 3004 !scalars 3005 integer,intent(in) :: cplex_dij,cplex_rf,ndij 3006 !arrays 3007 real(dp),intent(out) :: diju(:,:) 3008 real(dp),intent(out),optional :: diju_im(:,:) 3009 type(pawrhoij_type),intent(in) :: pawrhoij 3010 type(pawtab_type),intent(in) :: pawtab 3011 3012 !Local variables --------------------------------------- 3013 !scalars 3014 integer :: cplex_rhoij,ilmn,ilmnp,irhoij,jlmn,jlmnp,jrhoij,kklmn,kklmn1,klmn,klmn1,lmn2_size,sig1,sig2 3015 logical :: compute_diju_im 3016 real(dp) :: ro_im 3017 character(len=500) :: msg 3018 !arrays 3019 real(dp) :: ro(cplex_rf) 3020 3021 ! ************************************************************************* 3022 3023 !Useful data 3024 lmn2_size=pawtab%lmn2_size 3025 cplex_rhoij=pawrhoij%cplex 3026 compute_diju_im=(cplex_rf==2.and.present(diju_im)) 3027 3028 !Check data consistency 3029 if (size(diju,1)/=cplex_rf*lmn2_size.or.size(diju,2)/=ndij) then 3030 msg='invalid sizes for diju!' 3031 MSG_BUG(msg) 3032 end if 3033 if (compute_diju_im) then 3034 if (size(diju_im,1)/=lmn2_size.or.size(diju_im,2)/=ndij) then 3035 msg='invalid sizes for diju_im !' 3036 MSG_BUG(msg) 3037 end if 3038 end if 3039 if (cplex_rhoij<cplex_rf) then 3040 msg='cplex_rhoij must be >=cplex_rf!' 3041 MSG_BUG(msg) 3042 end if 3043 if (cplex_dij/=1) then 3044 msg='pawdiju_euijkl not yet available for cplex_dij=2!' 3045 MSG_ERROR(msg) 3046 end if 3047 3048 !------------------------------------------------------------------------ 3049 !----------- Allocations and initializations 3050 !------------------------------------------------------------------------ 3051 3052 diju=zero 3053 if (compute_diju_im) diju_im = zero 3054 3055 !Real on-site quantities 3056 if (cplex_rf==1) then 3057 do sig1=1,ndij 3058 do sig2=1,ndij 3059 jrhoij=1 3060 do irhoij=1,pawrhoij%nrhoijsel 3061 klmn=pawrhoij%rhoijselect(irhoij) 3062 ilmn=pawtab%indklmn(7,klmn) 3063 jlmn=pawtab%indklmn(8,klmn) 3064 ro(1)=pawrhoij%rhoijp(jrhoij,sig2) 3065 do jlmnp=1,pawtab%lmn_size 3066 do ilmnp=1,jlmnp 3067 klmn1 = ilmnp + jlmnp*(jlmnp-1)/2 3068 3069 ! Thanks to Eq.[I] in the comment above: 3070 diju(klmn1,sig1)=diju(klmn1,sig1)+ro(1)*pawtab%euijkl(sig1,sig2,ilmn,jlmn,ilmnp,jlmnp) 3071 if (ilmn/=jlmn) then 3072 diju(klmn1,sig1)=diju(klmn1,sig1)+ro(1)*pawtab%euijkl(sig1,sig2,jlmn,ilmn,ilmnp,jlmnp) 3073 end if 3074 3075 end do 3076 end do 3077 jrhoij=jrhoij+cplex_rhoij 3078 end do 3079 end do 3080 end do 3081 3082 !Complex on-site quantities 3083 else 3084 do sig1=1,ndij 3085 do sig2=1,ndij 3086 jrhoij=1 3087 do irhoij=1,pawrhoij%nrhoijsel 3088 klmn=pawrhoij%rhoijselect(irhoij) 3089 ilmn=pawtab%indklmn(7,klmn) 3090 jlmn=pawtab%indklmn(8,klmn) 3091 ro(1:2)=pawrhoij%rhoijp(jrhoij:jrhoij+1,sig2) 3092 do jlmnp=1,pawtab%lmn_size 3093 do ilmnp=1,jlmnp 3094 klmn1 = ilmnp + jlmnp*(jlmnp-1)/2 3095 kklmn1 = klmn1 + lmn2_size 3096 ro_im = pawrhoij%rhoijim(klmn1,sig2) 3097 3098 ! Thanks to Eq.[I] in the comment above: 3099 diju(klmn1 ,sig1)=diju(klmn1 ,sig1)+ro(1)*pawtab%euijkl(sig1,sig2,ilmn,jlmn,ilmnp,jlmnp) 3100 diju(kklmn1,sig1)=diju(kklmn1,sig1)+ro(2)*pawtab%euijkl(sig1,sig2,ilmn,jlmn,ilmnp,jlmnp) 3101 diju(kklmn1,sig1)=diju(kklmn1,sig1)+ro_im*pawtab%euijkl(sig1,sig2,ilmn,jlmn,ilmnp,jlmnp) 3102 if (compute_diju_im) then 3103 diju_im(klmn1,sig1)=diju_im(klmn1,sig1)+ro_im*pawtab%euijkl(sig1,sig2,ilmn,jlmn,ilmnp,jlmnp) 3104 end if 3105 3106 if (ilmn/=jlmn) then 3107 diju(klmn1 ,sig1)=diju(klmn1 ,sig1)+ro(1)*pawtab%euijkl(sig1,sig2,jlmn,ilmn,ilmnp,jlmnp) 3108 diju(kklmn1,sig1)=diju(klmn1 ,sig1)+ro(2)*pawtab%euijkl(sig1,sig2,jlmn,ilmn,ilmnp,jlmnp) 3109 diju(kklmn1,sig1)=diju(kklmn1,sig1)-ro_im*pawtab%euijkl(sig1,sig2,jlmn,ilmn,ilmnp,jlmnp) 3110 if (compute_diju_im) then 3111 diju_im(klmn1,sig1)=diju_im(klmn1,sig1)-ro_im*pawtab%euijkl(sig1,sig2,jlmn,ilmn,ilmnp,jlmnp) 3112 end if 3113 end if 3114 end do 3115 end do 3116 jrhoij=jrhoij+cplex_rhoij 3117 end do 3118 end do 3119 end do 3120 end if 3121 3122 end subroutine pawdiju_euijkl
m_pawdij/pawdijxc [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdijxc
FUNCTION
Compute the eXchange-Correlation contribution to the PAW pseudopotential strength Dij, using densities and potential expressed on a (r,theta,phi) grid (for one atom only): D_ij^XC= < Phi_i|Vxc( n1+ nc[+nhat])| Phi_j> -<tPhi_i|Vxc(tn1+tnc[+nhat])|tPhi_j> -Intg_omega [ Vxc(tn1+tnc[+nhat])(r). Sum_L(Qij^L(r)). dr]
INPUTS
cplex_rf=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX cplex_dij=1 if dij is REAL, 2 if complex (2 for spin-orbit) ndij= number of spin components nspden=number of spin density components nsppol=number of independent spin WF components pawang <type(pawang_type)>=paw angular mesh and related data, for current atom pawrad <type(pawrad_type)>=paw radial mesh and related data, for current atom pawtab <type(pawtab_type)>=paw tabulated starting data vxc1(cplex_rf*mesh_size,angl_size,nspden)=all-electron on-site XC potential for current atom given on a (r,theta,phi) grid vxct1(cplex_rf*mesh_size,angl_size,nspden)=all-electron on-site XC potential for current atom given on a (r,theta,phi) grid usexcnhat= 1 if compensation density is included in Vxc, 0 otherwise
OUTPUT
dijxc(cplex_rf*cplex_dij*lmn2_size,ndij)= D_ij^XC terms
NOTES
cplex_rf is for RF (phase e^(-i.q.r)), cplex_dij is for non-collinear (nspinor==2)
PARENTS
m_pawdij
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
1219 subroutine pawdijxc(cplex_rf,cplex_dij,dijxc,ndij,nspden,nsppol,& 1220 & pawang,pawrad,pawtab,vxc1,vxct1,usexcnhat) 1221 1222 1223 !This section has been created automatically by the script Abilint (TD). 1224 !Do not modify the following lines by hand. 1225 #undef ABI_FUNC 1226 #define ABI_FUNC 'pawdijxc' 1227 !End of the abilint section 1228 1229 implicit none 1230 1231 !Arguments --------------------------------------------- 1232 !scalars 1233 integer,intent(in) :: cplex_rf,cplex_dij,ndij,nspden,nsppol,usexcnhat 1234 type(pawang_type),intent(in) :: pawang 1235 !arrays 1236 real(dp),intent(in) :: vxc1(:,:,:),vxct1(:,:,:) 1237 real(dp),intent(out) :: dijxc(:,:) 1238 type(pawrad_type),intent(in) :: pawrad 1239 type(pawtab_type),intent(in) :: pawtab 1240 1241 !Local variables --------------------------------------- 1242 !scalars 1243 integer :: angl_size,idij,idijend,ij_size,ilm,ils,ils1,ilslm,ipts,ir,ir1,isel,ispden 1244 integer :: jlm,j0lm,klmn,klmn1,klmn2,klm,kln,l_size,lm0,lmax,lmin,lm_size,lmn2_size 1245 integer :: mesh_size,mm,nsploop 1246 real(dp) :: tmp,vi,vr,vxcijhat,vxcijhat_i 1247 character(len=500) :: msg 1248 !arrays 1249 real(dp),allocatable :: dijxc_idij(:),ff(:),gg(:),vxcij1(:),vxcij2(:),yylmr(:,:) 1250 1251 ! ************************************************************************* 1252 1253 !Useful data 1254 lm_size=pawtab%lcut_size**2 1255 lmn2_size=pawtab%lmn2_size 1256 ij_size=pawtab%ij_size 1257 l_size=pawtab%l_size 1258 mesh_size=pawtab%mesh_size 1259 angl_size=pawang%angl_size 1260 1261 !Check data consistency 1262 if (size(dijxc,1)/=cplex_rf*cplex_dij*lmn2_size.or.size(dijxc,2)/=ndij) then 1263 msg='invalid sizes for Dijxc !' 1264 MSG_BUG(msg) 1265 end if 1266 if (size(vxc1,1)/=cplex_rf*mesh_size.or.size(vxct1,1)/=cplex_rf*mesh_size.or.& 1267 & size(vxc1,2)/=angl_size.or.size(vxct1,2)/=angl_size.or.& 1268 & size(vxc1,3)/=nspden.or.size(vxct1,3)/=nspden) then 1269 msg='invalid sizes for vxc1 or vxct1 !' 1270 MSG_BUG(msg) 1271 end if 1272 1273 !Precompute products Ylm*Ylpmp 1274 lmax=1+maxval(pawtab%indklmn(4,1:lmn2_size)) 1275 LIBPAW_ALLOCATE(yylmr,(lmax**2*(lmax**2+1)/2,angl_size)) 1276 do ipts=1,angl_size 1277 do jlm=1,lmax**2 1278 j0lm=jlm*(jlm-1)/2 1279 do ilm=1,jlm 1280 klm=j0lm+ilm 1281 yylmr(klm,ipts)=pawang%ylmr(ilm,ipts)*pawang%ylmr(jlm,ipts) 1282 end do 1283 end do 1284 end do 1285 1286 !Init memory 1287 dijxc=zero 1288 LIBPAW_ALLOCATE(dijxc_idij,(cplex_rf*lmn2_size)) 1289 LIBPAW_ALLOCATE(vxcij1,(cplex_rf*ij_size)) 1290 LIBPAW_ALLOCATE(vxcij2,(cplex_rf*l_size)) 1291 LIBPAW_ALLOCATE(ff,(mesh_size)) 1292 LIBPAW_ALLOCATE(gg,(mesh_size)) 1293 1294 !---------------------------------------------------------- 1295 !Loop over spin components 1296 !---------------------------------------------------------- 1297 nsploop=nsppol;if (ndij==4) nsploop=4 1298 do idij=1,nsploop 1299 if (idij<=nsppol.or.(nspden==4.and.idij<=3)) then 1300 1301 idijend=idij+idij/3 1302 do ispden=idij,idijend 1303 1304 dijxc_idij=zero 1305 1306 ! ---------------------------------------------------------- 1307 ! Loop on angular mesh 1308 ! ---------------------------------------------------------- 1309 do ipts=1,angl_size 1310 1311 ! ===== Vxc_ij_1 (tmp) ===== 1312 vxcij1=zero 1313 if (cplex_rf==1) then 1314 do kln=1,ij_size 1315 ff(1:mesh_size)= & 1316 & vxc1(1:mesh_size,ipts,ispden)*pawtab%phiphj(1:mesh_size,kln) & 1317 & -vxct1(1:mesh_size,ipts,ispden)*pawtab%tphitphj(1:mesh_size,kln) 1318 call simp_gen(vxcij1(kln),ff,pawrad) 1319 end do 1320 else 1321 do kln=1,ij_size 1322 do ir=1,mesh_size 1323 ir1=2*ir 1324 ff(ir)= & 1325 & vxc1(ir1-1,ipts,ispden)*pawtab%phiphj(ir,kln) & 1326 & -vxct1(ir1-1,ipts,ispden)*pawtab%tphitphj(ir,kln) 1327 gg(ir)= & 1328 & vxc1(ir1,ipts,ispden)*pawtab%phiphj(ir,kln) & 1329 & -vxct1(ir1,ipts,ispden)*pawtab%tphitphj(ir,kln) 1330 end do 1331 call simp_gen(vxcij1(2*kln-1),ff,pawrad) 1332 call simp_gen(vxcij1(2*kln ),gg,pawrad) 1333 end do 1334 end if 1335 1336 ! ===== Vxc_ij_2 (tmp) ===== 1337 vxcij2=zero 1338 if (usexcnhat/=0) then 1339 if (cplex_rf==1) then 1340 do ils=1,l_size 1341 ff(1:mesh_size)=vxct1(1:mesh_size,ipts,ispden) & 1342 & *pawtab%shapefunc(1:mesh_size,ils) & 1343 & *pawrad%rad(1:mesh_size)**2 1344 call simp_gen(vxcij2(ils),ff,pawrad) 1345 end do 1346 else 1347 do ils=1,l_size 1348 do ir=1,mesh_size 1349 ir1=2*ir 1350 tmp=pawtab%shapefunc(ir,ils)*pawrad%rad(ir)**2 1351 ff(ir)=vxct1(ir1-1,ipts,ispden)*tmp 1352 gg(ir)=vxct1(ir1 ,ipts,ispden)*tmp 1353 end do 1354 call simp_gen(vxcij2(2*ils-1),ff,pawrad) 1355 call simp_gen(vxcij2(2*ils ),gg,pawrad) 1356 end do 1357 end if 1358 end if 1359 1360 ! ===== Integrate Vxc_ij_1 and Vxc_ij_2 over the angular mesh ===== 1361 ! ===== and accummulate in total Vxc_ij ===== 1362 if (cplex_rf==1) then 1363 do klmn=1,lmn2_size 1364 klm=pawtab%indklmn(1,klmn);kln=pawtab%indklmn(2,klmn) 1365 lmin=pawtab%indklmn(3,klmn);lmax=pawtab%indklmn(4,klmn) 1366 dijxc_idij(klmn)=dijxc_idij(klmn) & 1367 & +vxcij1(kln)*pawang%angwgth(ipts)*yylmr(klm,ipts)*four_pi 1368 if (usexcnhat/=0) then 1369 vxcijhat=zero 1370 do ils=lmin,lmax,2 1371 lm0=ils**2+ils+1 1372 vr=four_pi*pawang%angwgth(ipts)*vxcij2(ils+1) 1373 do mm=-ils,ils 1374 ilslm=lm0+mm;isel=pawang%gntselect(ilslm,klm) 1375 if (isel>0) then 1376 tmp=pawang%ylmr(ilslm,ipts)*pawtab%qijl(ilslm,klmn) 1377 vxcijhat=vxcijhat+vr*tmp 1378 end if 1379 end do 1380 end do 1381 dijxc_idij(klmn)=dijxc_idij(klmn)-vxcijhat 1382 end if 1383 end do ! Loop klmn 1384 else 1385 klmn1=1 1386 do klmn=1,lmn2_size 1387 klm=pawtab%indklmn(1,klmn);kln=pawtab%indklmn(2,klmn) 1388 lmin=pawtab%indklmn(3,klmn);lmax=pawtab%indklmn(4,klmn) 1389 tmp=pawang%angwgth(ipts)*yylmr(klm,ipts)*four_pi 1390 dijxc_idij(klmn1 )=dijxc_idij(klmn1 )+vxcij1(2*kln-1)*tmp 1391 dijxc_idij(klmn1+1)=dijxc_idij(klmn1+1)+vxcij1(2*kln )*tmp 1392 if (usexcnhat/=0) then 1393 vxcijhat=zero;vxcijhat_i=zero 1394 do ils=lmin,lmax,2 1395 lm0=ils**2+ils+1;ils1=2*(ils+1) 1396 vr=four_pi*pawang%angwgth(ipts)*vxcij2(ils1-1) 1397 vi=four_pi*pawang%angwgth(ipts)*vxcij2(ils1 ) 1398 do mm=-ils,ils 1399 ilslm=lm0+mm;isel=pawang%gntselect(ilslm,klm) 1400 if (isel>0) then 1401 tmp=pawang%ylmr(ilslm,ipts)*pawtab%qijl(ilslm,klmn) 1402 vxcijhat =vxcijhat +vr*tmp 1403 vxcijhat_i=vxcijhat_i+vi*tmp 1404 end if 1405 end do 1406 end do 1407 dijxc_idij(klmn1 )=dijxc_idij(klmn1 )-vxcijhat 1408 dijxc_idij(klmn1+1)=dijxc_idij(klmn1+1)-vxcijhat_i 1409 end if 1410 klmn1=klmn1+cplex_rf 1411 end do ! Loop klmn 1412 end if 1413 1414 ! ---------------------------------------------------------- 1415 ! End loop on angular points 1416 end do 1417 1418 ! ---------------------------------------------------------- 1419 ! Deduce some part of Dij according to symmetries 1420 ! ---------------------------------------------------------- 1421 1422 !if ispden=1 => real part of D^11_ij 1423 !if ispden=2 => real part of D^22_ij 1424 !if ispden=3 => real part of D^12_ij 1425 !if ispden=4 => imaginary part of D^12_ij 1426 klmn1=max(1,ispden-2);klmn2=1 1427 do klmn=1,lmn2_size 1428 dijxc(klmn1,idij)=dijxc_idij(klmn2) 1429 klmn1=klmn1+cplex_dij 1430 klmn2=klmn2+cplex_rf 1431 end do 1432 if (cplex_rf==2) then 1433 !Same storage with exp^(-i.q.r) phase 1434 klmn1=max(1,ispden-2)+lmn2_size*cplex_dij;klmn2=2 1435 do klmn=1,lmn2_size 1436 dijxc(klmn1,idij)=dijxc_idij(klmn2) 1437 klmn1=klmn1+cplex_dij 1438 klmn2=klmn2+cplex_rf 1439 end do 1440 endif 1441 1442 end do !ispden 1443 1444 !Non-collinear: D_ij(:,4)=Re[i.D^21_ij]=-Im[D^12_ij] 1445 else if (nspden==4.and.idij==4) then 1446 dijxc(:,idij)=dijxc(:,idij-1) 1447 if (cplex_dij==2) then 1448 do klmn=2,lmn2_size*cplex_dij,cplex_dij 1449 dijxc(klmn,idij)=-dijxc(klmn,idij) 1450 end do 1451 if (cplex_rf==2) then 1452 do klmn=2+lmn2_size*cplex_dij,2*lmn2_size*cplex_dij,cplex_dij 1453 dijxc(klmn,idij)=-dijxc(klmn,idij) 1454 end do 1455 end if 1456 end if 1457 1458 !Antiferro: D_ij(:,2)=D^down_ij=D^up_ij 1459 else if (nsppol==1.and.idij==2) then 1460 dijxc(:,idij)=dijxc(:,idij-1) 1461 end if 1462 1463 !---------------------------------------------------------- 1464 !End loop on spin density components 1465 end do 1466 1467 !Free temporary memory spaces 1468 LIBPAW_DEALLOCATE(yylmr) 1469 LIBPAW_DEALLOCATE(dijxc_idij) 1470 LIBPAW_DEALLOCATE(vxcij1) 1471 LIBPAW_DEALLOCATE(vxcij2) 1472 LIBPAW_DEALLOCATE(ff) 1473 LIBPAW_DEALLOCATE(gg) 1474 1475 end subroutine pawdijxc
m_pawdij/pawdijxcm [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawdijxcm
FUNCTION
Compute the eXchange-Correlation contribution to the PAW pseudopotential strength Dij, using densities and potential expressed as (l,m) spherical moments (for one atom only): D_ij^XC= < Phi_i|Vxc( n1+ nc[+nhat])| Phi_j> -<tPhi_i|Vxc(tn1+tnc[+nhat])|tPhi_j> -Intg_omega [ Vxc(tn1+tnc[+nhat])(r). Sum_L(Qij^L(r)). dr]
INPUTS
cplex_rf=(RF calculations only) - 1 if RF 1st-order quantities are REAL, 2 if COMPLEX cplex_dij=1 if dij is REAL, 2 if complex (2 for spin-orbit) lmselect(lm_size)=select the non-zero LM-moments of on-site potentials ndij= number of spin components nspden=number of spin density components nsppol=number of independent spin WF components pawang <type(pawang_type)>=paw angular mesh and related data, for current atom pawrad <type(pawrad_type)>=paw radial mesh and related data, for current atom pawtab <type(pawtab_type)>=paw tabulated starting data vxc1(cplex_rf*mesh_size,lm_size,nspden)=all-electron on-site XC potential for current atom given on (l,m) spherical moments vxct1(cplex_rf*mesh_size,lm_size,nspden)=all-electron on-site XC potential for current atom given on (l,m) spherical moments usexcnhat= 1 if compensation density is included in Vxc, 0 otherwise
OUTPUT
dijxc(cplex_rf*cplex_dij*lmn2_size,ndij)= D_ij^XC terms
NOTES
cplex_rf is for RF, cplex_dij is for non-collinear (nspinor==2)
PARENTS
m_pawdij
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
1819 subroutine pawdijxcm(cplex_rf,cplex_dij,dijxc,lmselect,ndij,nspden,nsppol,& 1820 & pawang,pawrad,pawtab,vxc1,vxct1,usexcnhat) 1821 1822 1823 !This section has been created automatically by the script Abilint (TD). 1824 !Do not modify the following lines by hand. 1825 #undef ABI_FUNC 1826 #define ABI_FUNC 'pawdijxcm' 1827 !End of the abilint section 1828 1829 implicit none 1830 1831 !Arguments --------------------------------------------- 1832 !scalars 1833 integer,intent(in) :: cplex_rf,cplex_dij,ndij,nspden,nsppol,usexcnhat 1834 type(pawang_type),intent(in) :: pawang 1835 !arrays 1836 logical :: lmselect(:) 1837 real(dp),intent(in) :: vxc1(:,:,:),vxct1(:,:,:) 1838 real(dp),intent(out) :: dijxc(:,:) 1839 type(pawrad_type),intent(in) :: pawrad 1840 type(pawtab_type),intent(in) :: pawtab 1841 1842 !Local variables --------------------------------------- 1843 !scalars 1844 integer :: idij,idijend,ij_size,ir,ir1,isel,ispden,klm,klm1,klmn,klmn1,klmn2,kln 1845 integer :: lm_size,lmn2_size,ll,mesh_size,nsploop 1846 real(dp) :: tmp,vxcij2,vxcij2_i 1847 character(len=500) :: msg 1848 !arrays 1849 real(dp),allocatable :: dijxc_idij(:),ff(:),gg(:),vxcij1(:) 1850 1851 ! ************************************************************************* 1852 1853 !Useful data 1854 lm_size=pawtab%lcut_size**2 1855 lmn2_size=pawtab%lmn2_size 1856 ij_size=pawtab%ij_size 1857 mesh_size=pawtab%mesh_size 1858 1859 !Check data consistency 1860 if (size(dijxc,1)/=cplex_rf*cplex_dij*lmn2_size.or.size(dijxc,2)/=ndij) then 1861 msg='invalid sizes for Dijxc !' 1862 MSG_BUG(msg) 1863 end if 1864 if (size(lmselect)/=lm_size) then 1865 msg='invalid size for lmselect !' 1866 MSG_BUG(msg) 1867 end if 1868 if (size(vxc1,1)/=cplex_rf*mesh_size.or.size(vxct1,1)/=cplex_rf*mesh_size.or.& 1869 & size(vxc1,2)/=lm_size.or.size(vxct1,2)/=lm_size.or.& 1870 & size(vxc1,3)/=nspden.or.size(vxct1,3)/=nspden) then 1871 msg='invalid sizes for vxc1 or vxct1 !' 1872 MSG_BUG(msg) 1873 end if 1874 1875 !Init memory 1876 dijxc=zero 1877 LIBPAW_ALLOCATE(dijxc_idij,(cplex_rf*lmn2_size)) 1878 LIBPAW_ALLOCATE(vxcij1,(cplex_rf*ij_size)) 1879 LIBPAW_ALLOCATE(ff,(mesh_size)) 1880 LIBPAW_ALLOCATE(gg,(mesh_size)) 1881 1882 !---------------------------------------------------------- 1883 !Loop over spin components 1884 !---------------------------------------------------------- 1885 nsploop=nsppol;if (ndij==4) nsploop=4 1886 do idij=1,nsploop 1887 if (idij<=nsppol.or.(nspden==4.and.idij<=3)) then 1888 1889 idijend=idij+idij/3 1890 do ispden=idij,idijend 1891 1892 dijxc_idij=zero 1893 1894 ! ---------------------------------------------------------- 1895 ! Summing over (l,m) moments 1896 ! ---------------------------------------------------------- 1897 do klm=1,lm_size 1898 if (lmselect(klm)) then 1899 1900 ! ===== Vxc_ij_1 (tmp) ===== 1901 vxcij1=zero 1902 if (cplex_rf==1) then 1903 do kln=1,ij_size 1904 ff(1:mesh_size)= & 1905 & vxc1(1:mesh_size,klm,ispden)*pawtab%phiphj(1:mesh_size,kln) & 1906 & -vxct1(1:mesh_size,klm,ispden)*pawtab%tphitphj(1:mesh_size,kln) 1907 call simp_gen(vxcij1(kln),ff,pawrad) 1908 end do 1909 else ! cplex_rf==2 1910 do kln=1,ij_size 1911 do ir=1,mesh_size 1912 ir1=2*ir 1913 ff(ir)= & 1914 & vxc1(ir1-1,klm,ispden)*pawtab%phiphj(ir,kln) & 1915 & -vxct1(ir1-1,klm,ispden)*pawtab%tphitphj(ir,kln) 1916 gg(ir)= & 1917 & vxc1(ir1,klm,ispden)*pawtab%phiphj(ir,kln) & 1918 & -vxct1(ir1,klm,ispden)*pawtab%tphitphj(ir,kln) 1919 end do 1920 call simp_gen(vxcij1(2*kln-1),ff,pawrad) 1921 call simp_gen(vxcij1(2*kln ),gg,pawrad) 1922 end do 1923 end if 1924 1925 ! ===== Vxc_ij_2 (tmp) ===== 1926 vxcij2=zero;vxcij2_i=zero 1927 if (usexcnhat/=0) then 1928 ll=1+int(sqrt(dble(klm)-0.1_dp)) 1929 if (cplex_rf==1) then 1930 ff(1:mesh_size)=vxct1(1:mesh_size,klm,ispden) & 1931 & *pawtab%shapefunc(1:mesh_size,ll) & 1932 & *pawrad%rad(1:mesh_size)**2 1933 call simp_gen(vxcij2,ff,pawrad) 1934 else ! cplex_rf==2 1935 do ir=1,mesh_size 1936 ir1=2*ir 1937 tmp=pawtab%shapefunc(ir,ll)*pawrad%rad(ir)**2 1938 ff(ir)=vxct1(ir1-1,klm,ispden)*tmp 1939 gg(ir)=vxct1(ir1 ,klm,ispden)*tmp 1940 end do 1941 call simp_gen(vxcij2 ,ff,pawrad) 1942 call simp_gen(vxcij2_i,gg,pawrad) 1943 end if 1944 end if 1945 1946 ! ===== Accumulate over klm moments Vxc_ij_1 and Vxc_ij_2 ===== 1947 ! ===== into total Vxc_ij ===== 1948 if (cplex_rf==1) then 1949 do klmn=1,lmn2_size 1950 klm1=pawtab%indklmn(1,klmn) 1951 kln=pawtab%indklmn(2,klmn) 1952 isel=pawang%gntselect(klm,klm1) 1953 if (isel>0) & 1954 & dijxc_idij(klmn)=dijxc_idij(klmn)+vxcij1(kln)*pawang%realgnt(isel) 1955 if (usexcnhat/=0) & 1956 dijxc_idij(klmn)=dijxc_idij(klmn)-pawtab%qijl(klm,klmn)*vxcij2 1957 end do ! Loop klmn 1958 else ! cplex_rf==2 1959 klmn1=1 1960 do klmn=1,lmn2_size 1961 klm1=pawtab%indklmn(1,klmn) 1962 kln=pawtab%indklmn(2,klmn) 1963 isel=pawang%gntselect(klm,klm1) 1964 if (isel>0) then 1965 dijxc_idij(klmn1 )=dijxc_idij(klmn1) & 1966 & +vxcij1(2*kln-1)*pawang%realgnt(isel) 1967 dijxc_idij(klmn1+1)=dijxc_idij(klmn1+1) & 1968 & +vxcij1(2*kln )*pawang%realgnt(isel) 1969 end if 1970 if (usexcnhat/=0) then 1971 dijxc_idij(klmn1 )=dijxc_idij(klmn1) & 1972 & -pawtab%qijl(klm,klmn)*vxcij2 1973 dijxc_idij(klmn1+1)=dijxc_idij(klmn1+1) & 1974 & -pawtab%qijl(klm,klmn)*vxcij2_i 1975 end if 1976 klmn1=klmn1+cplex_rf 1977 end do ! Loop klmn 1978 end if 1979 1980 end if ! klm selection 1981 end do ! Loop klm 1982 1983 ! ---------------------------------------------------------- 1984 ! Deduce some part of Dij according to symmetries 1985 ! ---------------------------------------------------------- 1986 1987 !if ispden=1 => real part of D^11_ij 1988 !if ispden=2 => real part of D^22_ij 1989 !if ispden=3 => real part of D^12_ij 1990 !if ispden=4 => imaginary part of D^12_ij 1991 klmn1=max(1,ispden-2);klmn2=1 1992 do klmn=1,lmn2_size 1993 dijxc(klmn1,idij)=dijxc_idij(klmn2) 1994 klmn1=klmn1+cplex_dij 1995 klmn2=klmn2+cplex_rf 1996 end do 1997 if (cplex_rf==2) then 1998 !Same storage with exp^(-i.q.r) phase 1999 klmn1=max(1,ispden-2)+lmn2_size*cplex_dij;klmn2=2 2000 do klmn=1,lmn2_size 2001 dijxc(klmn1,idij)=dijxc_idij(klmn2) 2002 klmn1=klmn1+cplex_dij 2003 klmn2=klmn2+cplex_rf 2004 end do 2005 endif 2006 2007 end do !ispden 2008 2009 !Non-collinear: D_ij(:,4)=Re[i.D^21_ij]=-Im[D^12_ij] 2010 else if (nspden==4.and.idij==4) then 2011 dijxc(:,idij)=dijxc(:,idij-1) 2012 if (cplex_dij==2) then 2013 do klmn=2,lmn2_size*cplex_dij,cplex_dij 2014 dijxc(klmn,idij)=-dijxc(klmn,idij) 2015 end do 2016 if (cplex_rf==2) then 2017 do klmn=2+lmn2_size*cplex_dij,2*lmn2_size*cplex_dij,cplex_dij 2018 dijxc(klmn,idij)=-dijxc(klmn,idij) 2019 end do 2020 end if 2021 end if 2022 2023 !Antiferro: D_ij(:,2)=D^down_ij=D^up_ij 2024 else if (nsppol==1.and.idij==2) then 2025 dijxc(:,idij)=dijxc(:,idij-1) 2026 end if 2027 2028 !---------------------------------------------------------- 2029 !End loop on spin density components 2030 end do 2031 2032 !Free temporary memory spaces 2033 LIBPAW_DEALLOCATE(dijxc_idij) 2034 LIBPAW_DEALLOCATE(vxcij1) 2035 LIBPAW_DEALLOCATE(ff) 2036 LIBPAW_DEALLOCATE(gg) 2037 2038 end subroutine pawdijxcm
m_pawdij/pawpupot [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawpupot
FUNCTION
Compute the PAW LDA+U on-site potential
INPUTS
cplex_dij=1 if dij is REAL, 2 if complex (2 for spin-orbit) ndij=number of spin components for Dij pawprtvol=control print volume and debugging output for PAW noccmmp(cplex_dij,2*lpawu+1,2*lpawu+1,ndij)=density matrix in the augm. region nocctot(ndij)=number of electrons in the correlated subspace pawtab(ntypat) <type(pawtab_type)>=paw tabulated starting data: %usepawu, %upawu, %jpau %vee(2*lpawu+1*4)=screened coulomb matrix
OUTPUT
vpawu(cplex_dij,lpawu*2+1,lpawu*2+1,ndij)=lda+u potential
(see eg PRB 52, 5467 (1995) [[cite:Liechenstein1995]])
PARENTS
ldau_self,m_pawdij,m_pawhr
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
4120 subroutine pawpupot(cplex_dij,ndij,noccmmp,nocctot,& 4121 & pawprtvol,pawtab,vpawu) 4122 4123 4124 !This section has been created automatically by the script Abilint (TD). 4125 !Do not modify the following lines by hand. 4126 #undef ABI_FUNC 4127 #define ABI_FUNC 'pawpupot' 4128 !End of the abilint section 4129 4130 implicit none 4131 4132 !Arguments --------------------------------------------- 4133 !scalars 4134 integer,intent(in) :: cplex_dij,ndij,pawprtvol 4135 type(pawtab_type),intent(in) :: pawtab 4136 !arrays 4137 real(dp),intent(in) :: noccmmp(:,:,:,:),nocctot(:) 4138 real(dp),intent(out) :: vpawu(:,:,:,:) 4139 4140 !Local variables --------------------------------------- 4141 !scalars 4142 !Option for interaction energy in case of non-collinear magnetism: 4143 ! 1: E_int=-J/4.N.(N-2) (better) 4144 ! 2: E_int=-J/2.(Nup.(Nup-1)+Ndn.(Ndn-1)) (Nup and Ndn are ill-defined) 4145 integer,parameter :: option_interaction=1 4146 4147 integer :: iplex,ispden,jspden,lpawu,m1,m11,m2,m21,m3,m31,m4,m41,nspden_eff 4148 real(dp) :: mnorm,mx,my,mz,n_sig,n_msig,n_tot,VUKStemp,n_sigs,n_msigs 4149 real(dp),save :: VUKS 4150 character(len=500) :: msg 4151 !arrays 4152 real(dp),parameter :: factcg(3:4)=(/one,-one/) 4153 real(dp) :: n34_msig(cplex_dij),n34_sig(cplex_dij) 4154 !real(dp) :: n43_sig(cplex_dij) 4155 4156 ! ***************************************************** 4157 4158 !Useful data 4159 lpawu=pawtab%lpawu 4160 4161 !Check data consistency 4162 if(option_interaction==3.and.pawtab%usepawu>=10) then 4163 msg = "Option_interaction==3 is not compatible with usepawu>=10 in pawpupot" 4164 MSG_ERROR(msg) 4165 end if 4166 if (size(vpawu,1)/=cplex_dij.or.size(vpawu,2)/=2*lpawu+1.or.& 4167 & size(vpawu,3)/=2*lpawu+1.or.size(vpawu,4)/=ndij) then 4168 write (msg,'(a,4I5, a,4I5)') ' invalid sizes for vpawu !',cplex_dij,2*lpawu+1,2*lpawu+1,ndij, & 4169 & ' /= ', size(vpawu,1), size(vpawu,2), size(vpawu,3), size(vpawu,4) 4170 MSG_BUG(msg) 4171 end if 4172 if (size(noccmmp,1)/=cplex_dij.or.size(noccmmp,2)/=2*lpawu+1.or.& 4173 & size(noccmmp,3)/=2*lpawu+1.or.size(noccmmp,4)/=ndij) then 4174 write (msg,'(a,4I5, a,4I5)') ' invalid sizes for noccmmp !',cplex_dij,2*lpawu+1,2*lpawu+1,ndij, & 4175 & ' /= ', size(noccmmp,1), size(noccmmp,2), size(noccmmp,3), size(noccmmp,4) 4176 MSG_BUG(msg) 4177 end if 4178 if (size(nocctot,1)/=ndij) then 4179 msg='invalid size for nocctot !' 4180 MSG_BUG(msg) 4181 end if 4182 4183 !===================================================== 4184 !Compute LDA+U Potential on the basis of projectors 4185 !cf PRB 52 5467 (1995) [[cite:Liechenstein1995]] 4186 !----------------------------------------------------- 4187 4188 vpawu=zero ; nspden_eff=ndij 4189 do ispden=1,nspden_eff 4190 4191 if (ispden<=2) then ! cases ndij=4, ispden=1,2 or ndij<4 4192 jspden=min(nspden_eff,2)-ispden+1 ! (ispden,ndij)=(1,4)=>jspden=2 4193 4194 if (nspden_eff<=2) then 4195 n_sig =nocctot(ispden) 4196 n_msig=nocctot(jspden) 4197 n_tot =n_sig+n_msig 4198 else 4199 n_tot=nocctot(1) 4200 mx=nocctot(2) 4201 my=nocctot(3) 4202 mz=nocctot(4) 4203 mnorm=sqrt(mx*mx+my*my+mz*mz) 4204 if (ispden==1) then 4205 ! n_sig =half*(n_tot+mnorm) 4206 ! n_msig=half*(n_tot-mnorm) 4207 n_sig =half*(n_tot+sign(mnorm,mz)) 4208 n_msig=half*(n_tot-sign(mnorm,mz)) 4209 else 4210 ! n_sig =half*(n_tot-mnorm) 4211 ! n_msig=half*(n_tot+mnorm) 4212 n_sig =half*(n_tot-sign(mnorm,mz)) 4213 n_msig=half*(n_tot+sign(mnorm,mz)) 4214 end if 4215 end if 4216 4217 n_sigs =n_sig/(float(2*lpawu+1)) 4218 n_msigs =n_msig/(float(2*lpawu+1)) 4219 do m1=-lpawu,lpawu 4220 m11=m1+lpawu+1 4221 do m2=-lpawu,lpawu 4222 m21=m2+lpawu+1 4223 do m3=-lpawu,lpawu 4224 m31=m3+lpawu+1 4225 do m4=-lpawu,lpawu 4226 m41=m4+lpawu+1 4227 n34_sig(:) =noccmmp(:,m31,m41,ispden) ! spin sigma 4228 n34_msig(:)=noccmmp(:,m31,m41,jspden) ! opposite spin (-sigma) 4229 if(m31==m41.and.pawtab%usepawu==3) then 4230 n34_sig(1)= n34_sig(1) - n_sigs 4231 n34_msig(1)= n34_msig(1) - n_msigs 4232 end if 4233 do iplex=1,cplex_dij 4234 vpawu(iplex,m11,m21,ispden)=vpawu(iplex,m11,m21,ispden) & 4235 & +n34_msig(iplex)*pawtab%vee(m11,m31,m21,m41) & 4236 & +n34_sig(iplex)*(pawtab%vee(m11,m31,m21,m41)-pawtab%vee(m11,m31,m41,m21)) 4237 end do 4238 ! if(abs(pawprtvol)>=3.and.m11==1.and.m21==1) then 4239 ! write(msg,'(a,i4,i4,2e20.10)') "m31,m41,vu=",m31,m41,& 4240 ! & vpawu(:,m11,m21,ispden) 4241 ! call wrtout(std_out,msg,'COLL') 4242 ! write(msg,'(a,4e20.10)') "vee",pawtab%vee(m11,m31,m21,m41),& 4243 ! & pawtab%vee(m11,m31,m41,m21) 4244 ! call wrtout(std_out,msg,'COLL') 4245 ! write(msg,'(a,4e20.10)') "n34_msig,n34_sig",n34_msig(1),n34_sig(1) 4246 ! call wrtout(std_out,msg,'COLL') 4247 ! end if 4248 end do 4249 end do 4250 ! if(abs(pawprtvol)>=3) then 4251 ! if(m11/=m21) then 4252 ! write(msg,'(a,i4,i4,2e20.10)') "vu=",m11,m21,vpawu(:,m11,m21,ispden) 4253 ! call wrtout(std_out,msg,'COLL') 4254 ! write(msg,'(a,2e20.10)') "vupred=",-pawtab%upawu*noccmmp(:,m21,m11,ispden) 4255 ! call wrtout(std_out,msg,'COLL') 4256 ! end if 4257 ! end if 4258 end do ! m2 4259 if(abs(pawprtvol)>=3) then 4260 write(msg,'(a,i3,14f11.5)') & 4261 & "vpawu ",m11, (vpawu(:,m11,m21,ispden),m21=1,2*lpawu+1) 4262 call wrtout(std_out, msg,'COLL') 4263 write(msg,'(a,i3,14f11.5)') & 4264 & "noccmmp ",m11, (noccmmp(:,m11,m21,ispden),m21=1,2*lpawu+1) 4265 call wrtout(std_out, msg,'COLL') 4266 end if 4267 4268 ! Full localized limit 4269 if(pawtab%usepawu==1.or.pawtab%usepawu==4) then ! not activated if usepawu=10 !! 4270 ! Here we compute vpawu=vpawu-v_dc 4271 vpawu(1,m11,m11,ispden)=vpawu(1,m11,m11,ispden)-pawtab%upawu*(n_tot-half) 4272 if (ndij/=4.or.option_interaction==2) then 4273 if(pawtab%usepawu/=4) then 4274 vpawu(1,m11,m11,ispden)=vpawu(1,m11,m11,ispden)+pawtab%jpawu*(n_sig-half) 4275 else 4276 vpawu(1,m11,m11,ispden)=vpawu(1,m11,m11,ispden)+half*pawtab%jpawu*(n_tot-one) 4277 endif 4278 else if (ndij==4.and.option_interaction==1) then 4279 vpawu(1,m11,m11,ispden)=vpawu(1,m11,m11,ispden)+half*pawtab%jpawu*(n_tot-one) 4280 else if (ndij==4.and.option_interaction==3) then 4281 ! Here vdc^{alpha,beta}=\vect{m}.\vect{sigma}^{\beta,\alpha} 4282 vpawu(1,m11,m11,ispden)=vpawu(1,m11,m11,ispden)+half*pawtab%jpawu*(n_tot-one) 4283 end if 4284 4285 ! Around mean field 4286 else if(pawtab%usepawu==2) then 4287 vpawu(1,m11,m11,ispden)=vpawu(1,m11,m11,ispden)-n_msig*pawtab%upawu & 4288 & -n_sig*(pawtab%upawu-pawtab%jpawu) & 4289 & *(dble(2*lpawu)/dble(2*lpawu+1)) 4290 end if 4291 4292 ! if (abs(pawprtvol)>=3) then 4293 ! write(msg,'(a,i4,i4,2x,e20.10)') "vudiag= ",m11,m11,vpawu(1,m11,m11,ispden) 4294 ! call wrtout(std_out, msg,'COLL') 4295 ! write(msg,'(a,2e20.10)') "vudiagpred= ",pawtab%upawu*(half-noccmmp(:,m11,m11,ispden)) 4296 ! call wrtout(std_out, msg,'COLL') 4297 ! end if 4298 if(abs(pawprtvol)>=3) then 4299 write(msg,*) "nocctot",nocctot 4300 call wrtout(std_out, msg,'COLL') 4301 write(msg,'(a,i3,14f11.5)') & 4302 & "vpawu 2",m11, (vpawu(:,m11,m21,ispden),m21=1,2*lpawu+1) 4303 call wrtout(std_out, msg,'COLL') 4304 write(msg,'(a,i3,14f11.5)') & 4305 & "noccmmp2",m11, (noccmmp(:,m11,m21,ispden),m21=1,2*lpawu+1) 4306 call wrtout(std_out, msg,'COLL') 4307 end if 4308 end do ! m1 4309 4310 end if ! ispden<=2 4311 4312 ! Non-collinear magnetism: add non-diagonal term; see (Eq 6) in PRB 72, 024458 (2005) [[cite:Shurikov2005]] 4313 ! BA Here, we compute the transpose --- with respect to spin indices --- of 4314 ! BA equation (6) of this reference, because of differences in notations, 4315 ! BA namely Eband=\sum rhoij^{alpha,beta}*Dij(beta,alpha) contrary to PRB 72, 024458 (2005) [[cite:Shurikov2005]] 4316 if (ispden>=3) then 4317 mx=nocctot(2) 4318 my=nocctot(3) 4319 do m1=-lpawu,lpawu 4320 m11=m1+lpawu+1 4321 do m2=-lpawu,lpawu 4322 m21=m2+lpawu+1 4323 do m3=-lpawu,lpawu 4324 m31=m3+lpawu+1 4325 do m4=-lpawu,lpawu 4326 m41=m4+lpawu+1 4327 ! n43_sig(:) =noccmmp(:,m41,m31,ispden) 4328 ! vpawu(1,m11,m21,ispden)=vpawu(1,m11,m21,ispden)-n43_sig(1)*pawtab%vee(m11,m31,m41,m21) 4329 ! vpawu(2,m11,m21,ispden)=vpawu(2,m11,m21,ispden)+n43_sig(2)*pawtab%vee(m11,m31,m41,m21) 4330 n34_sig(:) =noccmmp(:,m31,m41,ispden) 4331 vpawu(1,m11,m21,ispden)=vpawu(1,m11,m21,ispden)-n34_sig(1)*pawtab%vee(m11,m31,m41,m21) 4332 vpawu(2,m11,m21,ispden)=vpawu(2,m11,m21,ispden)-n34_sig(2)*pawtab%vee(m11,m31,m41,m21) 4333 end do 4334 end do 4335 end do 4336 if((pawtab%usepawu==1.or.pawtab%usepawu==4).and.option_interaction==3) then ! not activated if usepawu=10 !! 4337 vpawu(1,m11,m11,ispden)=vpawu(1,m11,m21,ispden)+half*pawtab%jpawu*mx 4338 if(ispden==3) then 4339 vpawu(2,m11,m11,ispden)=vpawu(1,m11,m21,ispden)-half*pawtab%jpawu*my 4340 else 4341 vpawu(2,m11,m11,ispden)=vpawu(1,m11,m21,ispden)+half*pawtab%jpawu*my 4342 end if 4343 end if 4344 end do 4345 end if 4346 4347 if(abs(pawprtvol)>=3) then 4348 write(std_out,*) "vpawu, ispden",ispden 4349 do m11=1,2*lpawu+1 4350 write(msg,'(12(1x,9(1x,"(",f10.7,",",f10.7,")")))') & 4351 & (vpawu(1:cplex_dij,m11,m21,ispden),m21=1,2*lpawu+1) 4352 call wrtout(std_out,msg,'COLL') 4353 end do 4354 end if 4355 4356 ! Printing for test 4357 if (abs(pawprtvol)>=3) then 4358 if (ispden==1) VUKS=zero 4359 VUKStemp=zero 4360 do m1=-lpawu,lpawu 4361 m11=m1+lpawu+1 4362 do m2=-lpawu,lpawu 4363 m21=m2+lpawu+1 4364 VUKStemp=VUKStemp+vpawu(1,m11,m21,ispden)*noccmmp(1,m11,m21,ispden) 4365 if (cplex_dij == 2) then 4366 VUKStemp=VUKStemp-vpawu(2,m11,m21,ispden)*noccmmp(2,m11,m21,ispden) 4367 end if 4368 write(msg,'(a,2e20.10,2e20.10)') "m1,m2,vpawu,noccmmp= ", & 4369 & vpawu(:,m11,m21,ispden),noccmmp(:,m11,m21,ispden) 4370 call wrtout(std_out, msg,'COLL') 4371 end do 4372 end do 4373 VUKS=VUKS+VUKStemp 4374 write(msg,*) "pawpupot: VUKStemp= ",ispden,VUKStemp 4375 call wrtout(std_out, msg,'COLL') 4376 if (ispden==nspden_eff) then 4377 write(msg,*) "pawpupot: VUKS= ",ispden,VUKS 4378 call wrtout(std_out, msg,'COLL') 4379 end if 4380 end if 4381 4382 end do ! Loop on ispden 4383 4384 end subroutine pawpupot
m_pawdij/pawxpot [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
pawxpot
FUNCTION
Compute the PAW Local Exact-Exchange on-site potential
INPUTS
ndij=number of spin components for Dij pawprtvol=control print volume and debugging output for PAW paw_ij <type(paw_ij_type)>=paw arrays given on (i,j) channels pawtab <type(pawtab_type)>=paw tabulated starting data: pawrhoij <type(pawrhoij_type)>= paw rhoij occupancies and related data
OUTPUT
paw_ij%vpawx(pawtab%lexexch*2+1,pawtab%lexexch*2+1)=local exact-exchange potential
PARENTS
m_pawdij,pawdenpot
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
4414 subroutine pawxpot(ndij,pawprtvol,pawrhoij,pawtab,vpawx) 4415 4416 4417 !This section has been created automatically by the script Abilint (TD). 4418 !Do not modify the following lines by hand. 4419 #undef ABI_FUNC 4420 #define ABI_FUNC 'pawxpot' 4421 !End of the abilint section 4422 4423 implicit none 4424 4425 !Arguments --------------------------------------------- 4426 !scalars 4427 integer,intent(in) :: ndij,pawprtvol 4428 type(pawrhoij_type),intent(in) :: pawrhoij 4429 type(pawtab_type),intent(in) :: pawtab 4430 real(dp),intent(out) :: vpawx(:,:,:) 4431 4432 !Local variables --------------------------------------- 4433 !scalars 4434 integer :: irhoij,irhoij1,ispden,jrhoij,jrhoij1,klmn,klmn1,lexexch,ll,lmn2_size 4435 integer :: m11,m21,m31,m41,n1,n2,n3,n4,nk,nn1,nn2,nspden_eff 4436 real(dp) :: tot 4437 character(len=500) :: msg 4438 !arrays 4439 integer :: indn(3,3) 4440 real(dp) :: factnk(6) 4441 4442 ! ***************************************************** 4443 4444 !Useful data 4445 lexexch=pawtab%lexexch 4446 lmn2_size=pawtab%lmn2_size 4447 if (pawtab%nproju==1) nk=1 4448 if (pawtab%nproju==2) nk=6 4449 factnk(1)=one;factnk(2)=one;factnk(3)=one 4450 factnk(4)=two;factnk(5)=two;factnk(6)=two 4451 indn(1,1)=1;indn(1,2)=4;indn(1,3)=5 4452 indn(2,1)=4;indn(2,2)=2;indn(2,3)=6 4453 indn(3,1)=5;indn(3,2)=6;indn(3,3)=3 4454 4455 !Check data consistency 4456 if (size(vpawx,1)/=1.or.size(vpawx,2)/=lmn2_size.or.& 4457 & size(vpawx,3)/=ndij) then 4458 msg='invalid sizes for vpawx !' 4459 MSG_BUG(msg) 4460 end if 4461 4462 !===================================================== 4463 !Compute local exact exchange Potential 4464 !on the basis of projectors. 4465 !----------------------------------------------------- 4466 4467 vpawx=zero ; nspden_eff=ndij 4468 do ispden=1,nspden_eff 4469 jrhoij=1 4470 do irhoij=1,pawrhoij%nrhoijsel 4471 klmn=pawrhoij%rhoijselect(irhoij) 4472 if(pawtab%indklmn(3,klmn)==0.and.pawtab%indklmn(4,klmn)==2*lexexch) then 4473 m11=pawtab%klmntomn(1,klmn);m21=pawtab%klmntomn(2,klmn) 4474 n1=pawtab%klmntomn(3,klmn);n2=pawtab%klmntomn(4,klmn) 4475 nn1=(n1*n2)/2+1 4476 jrhoij1=1 4477 do irhoij1=1,pawrhoij%nrhoijsel 4478 klmn1=pawrhoij%rhoijselect(irhoij1) 4479 if(pawtab%indklmn(3,klmn1)==0.and.pawtab%indklmn(4,klmn1)==2*lexexch) then 4480 m31=pawtab%klmntomn(1,klmn1);m41=pawtab%klmntomn(2,klmn1) 4481 n3=pawtab%klmntomn(3,klmn1);n4=pawtab%klmntomn(4,klmn1) 4482 nn2=(n3*n4)/2+1 4483 do ll=1,lexexch+1 4484 vpawx(1,klmn,ispden)=vpawx(1,klmn,ispden)& 4485 & -pawtab%vex(m11,m31,m41,m21,ll)*pawtab%dltij(klmn1) & 4486 & *pawtab%fk(indn(nn1,nn2),ll)*pawrhoij%rhoijp(jrhoij1,ispden) 4487 end do 4488 4489 end if 4490 jrhoij1=jrhoij1+pawrhoij%cplex 4491 end do !irhoij1 4492 end if 4493 jrhoij=jrhoij+pawrhoij%cplex 4494 end do !irhoij 4495 end do !ispden 4496 4497 !Test 4498 if (abs(pawprtvol)>=2) then 4499 tot=zero 4500 do ispden=1,pawrhoij%nspden 4501 jrhoij=1 4502 do irhoij=1,pawrhoij%nrhoijsel 4503 klmn=pawrhoij%rhoijselect(irhoij) 4504 tot=tot+vpawx(1,klmn,ispden)*pawrhoij%rhoijp(jrhoij,ispden)*pawtab%dltij(klmn) 4505 jrhoij=jrhoij+pawrhoij%cplex 4506 end do 4507 end do 4508 write(msg, '(a,es22.15)' )" Vpawx: tot=",tot*half 4509 call wrtout(std_out,msg,'COLL') 4510 end if 4511 4512 end subroutine pawxpot
m_pawdij/symdij [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
symdij
FUNCTION
Symmetrize PAW non-local strengths Dij Symmetrize total Dij or one part of it
INPUTS
gprimd(3,3)=dimensional primitive translations for reciprocal space(bohr^-1). indsym(4,nsym,natom)=indirect indexing array for atom labels ipert=index of perturbation if pawrhoij is a pertubed rhoij no meaning for ground-state calculations (should be 0) [mpi_atmtab(:)]=--optional-- indexes of the atoms treated by current proc [comm_atom]=--optional-- MPI communicator over atoms my_natom=number of atoms treated by current processor natom=number of atoms in cell nsym=number of symmetry elements in space group ntypat=number of types of atoms in unit cell. option_dij=choose which part of Dij has to be symmetrized (which paw_ij(:)%dijxxx): 0: total dij (dij) 1: dij due to compensation charge (dijhat) 2: dij due to +U (dijU) 3: dij XC (dijxc) 4: dij XC due to compensation charge (dijxc_hat) 5: dij XC valence only (dijxc_val) 6: dij spin-orbit (dijso) 7: dij exact exchange (dijexxc) 8: dij, RF frozen part (dijfr) 9: dij due to nuclear dipoles 10: dij Hartree 11: dij Fock paw_ij(natom)%cplex_rf=2 if exp^(-i.q.r) phase from RF at q<>0, 1 otherwise paw_ij(natom)%cplex_dij=1 if dij are REAL, 2 if they are COMPLEX paw_ij(natom)%lmn_size=number of (l,m,n) elements for the paw basis paw_ij(natom)%nspden=number of spin-density components paw_ij(natom)%nsppol=number of independant spin-density components paw_ij(natom)%dij(lmn2_size,nspden)=non-symmetrized paw dij quantities pawang <type(pawang_type)>=angular mesh discretization and related data pawprtvol=control print volume and debugging output for PAW pawtab(ntypat) <type(pawtab_type)>=paw tabulated starting data [qphon(3)]=--optional-- (RF calculations only) - wavevector of the phonon rprimd(3,3)=real space primitive translations. symafm(nsym)=(anti)ferromagnetic part of symmetry operations symrec(3,3,nsym)=symmetries of group in terms of operations on reciprocal space primitive translations
SIDE EFFECTS
paw_ij(natom)%dij???(cplex_dij*lmn2_size,nspden)=symmetrized dij quantities as output
PARENTS
bethe_salpeter,dfpt_scfcv,m_pawdij,paw_mknewh0,respfn,scfcv,screening sigma
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
4576 subroutine symdij(gprimd,indsym,ipert,my_natom,natom,nsym,ntypat,option_dij,& 4577 & paw_ij,pawang,pawprtvol,pawtab,rprimd,symafm,symrec, & 4578 & mpi_atmtab,comm_atom,qphon) ! optional arguments (parallelism) 4579 4580 4581 !This section has been created automatically by the script Abilint (TD). 4582 !Do not modify the following lines by hand. 4583 #undef ABI_FUNC 4584 #define ABI_FUNC 'symdij' 4585 !End of the abilint section 4586 4587 implicit none 4588 4589 !Arguments --------------------------------------------- 4590 !scalars 4591 integer,intent(in) :: ipert,my_natom,natom,nsym,ntypat,option_dij,pawprtvol 4592 integer,optional,intent(in) :: comm_atom 4593 type(pawang_type),intent(in) :: pawang 4594 !arrays 4595 integer,intent(in) :: indsym(4,nsym,natom),symafm(nsym),symrec(3,3,nsym) 4596 integer,optional,target,intent(in) :: mpi_atmtab(:) 4597 real(dp),intent(in) :: gprimd(3,3),rprimd(3,3) 4598 real(dp),intent(in),optional :: qphon(3) 4599 type(paw_ij_type),intent(inout) :: paw_ij(my_natom) 4600 type(pawtab_type),target,intent(in) :: pawtab(ntypat) 4601 4602 !Local variables --------------------------------------- 4603 !scalars 4604 integer :: at_indx,cplex_rf,cplex_dij,iafm,iatom,iatom_tot,ii 4605 integer :: il,il0,ilmn,iln,iln0,ilpm,indexi,indexii,indexj,indexjj,indexjj0,indexk,indexkc,indexkc_rf 4606 integer :: iplex,iplex_rf,irot,ispden,itypat,j0lmn,jl,jl0,jlmn,jln,jln0,jlpm,jspden 4607 integer :: klmn,klmnc,kspden,lmn_size,lmn2_size,mi,mj,my_comm_atom,my_cplex_rf,my_cplex_dij,my_ndij 4608 integer :: mu,natinc,ndij0,ndij1,nu,optsym,sz1,sz2 4609 logical,parameter :: afm_noncoll=.true. ! TRUE if antiferro symmetries are used with non-collinear magnetism 4610 logical :: antiferro,have_phase,my_atmtab_allocated,noncoll,paral_atom,use_afm 4611 !DEBUG_ALTERNATE_ALGO 4612 !Set to TRUE to choose an alternate algorithm (with another representation) 4613 !to symmetrize Dij within non-collinear magnetism or spin-orbit 4614 logical,parameter :: lsymnew=.false. 4615 !DEBUG_ALTERNATE_ALGO 4616 real(dp) :: arg,factafm,zarot2 4617 character(len=6) :: pertstrg,wrt_mode 4618 character(len=500) :: msg 4619 !arrays 4620 integer :: nsym_used(2) 4621 integer, pointer :: indlmn(:,:) 4622 integer,pointer :: my_atmtab(:) 4623 integer :: idum(0) 4624 real(dp) :: dijc(2),fact(2),factsym(2),phase(2) 4625 real(dp) :: rotdij(2,2,2),rotmag(2,3,2),sumdij(2,2,2),summag(2,3,2) 4626 real(dp),allocatable :: dijnew(:,:,:),dijtmp(:,:),symrec_cart(:,:,:) 4627 character(len=7),parameter :: dspin(6)=(/"up ","down ","up-up ", & 4628 & "dwn-dwn","up-dwn ","dwn-up "/) 4629 type(coeff2_type),target, allocatable :: my_tmp_dij(:) 4630 type(coeff2_type),pointer :: tmp_dij(:) 4631 4632 !DEBUG_ALTERNATE_ALGO 4633 !integer :: i1,i2,i3,i4,symrel_conv(3,3) 4634 !real(dp) :: spinrot(4) 4635 !real(dp),allocatable :: dijtemp(:,:),sumrhoso(:,:) 4636 !complex(dpc) :: dijt(2,2),dijt2(2,2),Rspinrot(2,2) 4637 !DEBUG_ALTERNATE_ALGO 4638 4639 ! ********************************************************************* 4640 4641 !Tests of compatibility: 4642 if (my_natom>0) then 4643 if ((option_dij==1.and.paw_ij(1)%has_dijhat==0).or.& 4644 & (option_dij==2.and.paw_ij(1)%has_dijU==0).or.& 4645 & (option_dij==3.and.paw_ij(1)%has_dijxc==0).or.& 4646 & (option_dij==4.and.paw_ij(1)%has_dijxc_hat==0).or.& 4647 & (option_dij==5.and.paw_ij(1)%has_dijxc_val==0).or.& 4648 & (option_dij==6.and.paw_ij(1)%has_dijso==0).or.& 4649 & (option_dij==7.and.paw_ij(1)%has_dijexxc==0).or.& 4650 & (option_dij==8.and.paw_ij(1)%has_dijfr==0).or.& 4651 & (option_dij==9.and.paw_ij(1)%has_dijnd==0).or.& 4652 & (option_dij==10.and.paw_ij(1)%has_dijhartree==0).or.& 4653 & (option_dij==11.and.paw_ij(1)%has_dijfock==0)) then 4654 msg='Incompatibilty between option_dij and allocation of Dij!' 4655 MSG_BUG(msg) 4656 end if 4657 end if 4658 4659 !Set up parallelism over atoms 4660 paral_atom=(present(comm_atom).and.(my_natom/=natom)) 4661 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 4662 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 4663 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom) 4664 4665 !Symmetrization occurs only when nsym>1 4666 if (nsym>1.and.ipert/=natom+1.and.ipert/=natom+10) then 4667 4668 if (pawang%nsym==0) then 4669 msg='pawang%zarot must be allocated!' 4670 MSG_BUG(msg) 4671 end if 4672 4673 ! Have to make a temporary copy of dij 4674 LIBPAW_DATATYPE_ALLOCATE(my_tmp_dij,(my_natom)) 4675 my_cplex_rf=1;my_cplex_dij=1;my_ndij=1 4676 if (my_natom>0) then 4677 my_cplex_rf=paw_ij(1)%cplex_rf 4678 my_cplex_dij=paw_ij(1)%cplex_dij 4679 my_ndij=paw_ij(1)%ndij 4680 if (option_dij==4.or.option_dij==5.or.option_dij==9) my_cplex_rf=1 4681 if (option_dij==10) my_cplex_dij=1 4682 if (option_dij==10) my_ndij=1 4683 do iatom=1,my_natom 4684 lmn2_size=paw_ij(iatom)%lmn2_size 4685 sz1=my_cplex_rf*my_cplex_dij*lmn2_size;sz2=my_ndij 4686 LIBPAW_ALLOCATE(my_tmp_dij(iatom)%value,(sz1,sz2)) 4687 LIBPAW_ALLOCATE(dijtmp,(sz1,sz2)) 4688 if (option_dij==0) then 4689 dijtmp(:,:)=paw_ij(iatom)%dij(:,:) 4690 else if (option_dij==1) then 4691 dijtmp(:,:)=paw_ij(iatom)%dijhat(:,:) 4692 else if (option_dij==2) then 4693 dijtmp(:,:)=paw_ij(iatom)%dijU(:,:) 4694 else if (option_dij==3) then 4695 dijtmp(:,:)=paw_ij(iatom)%dijxc(:,:) 4696 else if (option_dij==4) then 4697 dijtmp(:,:)=paw_ij(iatom)%dijxc_hat(:,:) 4698 else if (option_dij==5) then 4699 dijtmp(:,:)=paw_ij(iatom)%dijxc_val(:,:) 4700 else if (option_dij==6) then 4701 dijtmp(:,:)=paw_ij(iatom)%dijso(:,:) 4702 else if (option_dij==7) then 4703 dijtmp(:,:)=paw_ij(iatom)%dijexxc(:,:) 4704 else if (option_dij==8) then 4705 dijtmp(:,:)=paw_ij(iatom)%dijfr(:,:) 4706 else if (option_dij==9) then 4707 dijtmp(:,:)=paw_ij(iatom)%dijnd(:,:) 4708 else if (option_dij==10) then 4709 dijtmp(:,1)=paw_ij(iatom)%dijhartree(:) 4710 else if (option_dij==11) then 4711 dijtmp(:,:)=paw_ij(iatom)%dijfock(:,:) 4712 end if 4713 !Has to translate Dij^{alpha,beta} into (Dij, Dij magnetic field) format 4714 if (my_ndij==4) then 4715 my_tmp_dij(iatom)%value(:,1)=dijtmp(:,1)+dijtmp(:,2) 4716 my_tmp_dij(iatom)%value(:,2)=dijtmp(:,3)+dijtmp(:,4) 4717 my_tmp_dij(iatom)%value(:,4)=dijtmp(:,1)-dijtmp(:,2) 4718 do klmn=1,paw_ij(iatom)%lmn2_size 4719 my_tmp_dij(iatom)%value(2*klmn-1,3)=-dijtmp(2*klmn ,3)+dijtmp(2*klmn ,4) 4720 my_tmp_dij(iatom)%value(2*klmn ,3)= dijtmp(2*klmn-1,3)-dijtmp(2*klmn-1,4) 4721 end do 4722 !DEBUG_ALTERNATE_ALGO 4723 ! if(lsymnew) my_tmp_dij(iatom)%value(:,:)=dijtmp(:,:) 4724 !DEBUG_ALTERNATE_ALGO 4725 else 4726 my_tmp_dij(iatom)%value(:,:)=dijtmp(:,:) 4727 end if 4728 LIBPAW_DEALLOCATE(dijtmp) 4729 end do 4730 end if 4731 4732 antiferro=.false.;noncoll=.false. 4733 if (my_natom>0) then 4734 ! Antiferro case ? 4735 antiferro=(paw_ij(1)%nspden==2.and.paw_ij(1)%nsppol==1.and.my_ndij/=4) 4736 ! Non-collinear case 4737 noncoll=(my_ndij==4) 4738 if (noncoll.and.my_cplex_dij/=2) then 4739 msg='cplex_dij must be 2 with ndij=4!' 4740 MSG_BUG(msg) 4741 end if 4742 end if 4743 ! Do we use antiferro symmetries ? 4744 use_afm=((antiferro).or.(noncoll.and.afm_noncoll)) 4745 4746 ! Do we have a phase due to q-vector (phonons only) ? 4747 have_phase=.false. 4748 if (ipert>0.and.present(qphon).and.my_natom>0) then 4749 have_phase=(abs(qphon(1))>tol8.or.abs(qphon(2))>tol8.or.abs(qphon(3))>tol8) 4750 if (have_phase.and.paw_ij(1)%cplex_rf==1) then 4751 msg='Should have cplex_rf=2 for a non-zero q!' 4752 MSG_BUG(msg) 4753 end if 4754 !DEBUG_ALTERNATE_ALGO 4755 ! if(lsymnew.and.have_phase) then 4756 ! msg='symdij: alternate algo not available for phonons at q<>0!' 4757 ! MSG_BUG(msg) 4758 ! end if 4759 !DEBUG_ALTERNATE_ALGO 4760 end if 4761 4762 ! Parallelism: gather all Dij 4763 if (paral_atom) then 4764 LIBPAW_DATATYPE_ALLOCATE(tmp_dij,(natom)) 4765 call pawdij_gather(my_tmp_dij,tmp_dij,my_comm_atom,my_atmtab) 4766 do iatom=1,my_natom 4767 LIBPAW_DEALLOCATE(my_tmp_dij(iatom)%value) 4768 end do 4769 LIBPAW_DATATYPE_DEALLOCATE(my_tmp_dij) 4770 else 4771 tmp_dij=>my_tmp_dij 4772 end if 4773 4774 if (noncoll) then 4775 LIBPAW_ALLOCATE(symrec_cart,(3,3,nsym)) 4776 do irot=1,nsym 4777 symrec_cart(:,:,irot)=symdij_symcart(gprimd,rprimd,symrec(:,:,irot)) 4778 end do 4779 !DEBUG_ALTERNATE_ALGO 4780 ! if(lsymnew) then 4781 ! LIBPAW_ALLOCATE(sumrhoso,(my_cplex_dij,4)) 4782 ! end if 4783 !DEBUG_ALTERNATE_ALGO 4784 end if 4785 4786 ndij1=1 4787 if (antiferro) ndij1=2 4788 if (noncoll) ndij1=4 4789 ndij1=min(ndij1,my_ndij) 4790 ndij0=ndij1-1 4791 LIBPAW_ALLOCATE(dijnew,(my_cplex_dij,ndij1,my_cplex_rf)) 4792 4793 ! Loops over atoms and spin components 4794 do iatom=1,my_natom 4795 iatom_tot=iatom;if (paral_atom) iatom_tot=my_atmtab(iatom) 4796 itypat=paw_ij(iatom)%itypat 4797 lmn_size=paw_ij(iatom)%lmn_size 4798 lmn2_size=paw_ij(iatom)%lmn2_size 4799 cplex_dij=min(paw_ij(iatom)%cplex_dij,my_cplex_dij) 4800 cplex_rf=min(paw_ij(iatom)%cplex_rf,my_cplex_rf) 4801 indlmn => pawtab(itypat)%indlmn 4802 4803 !DEBUG_ALTERNATE_ALGO 4804 ! if (noncoll.and.lsymnew) then 4805 ! LIBPAW_ALLOCATE(dijtemp,(cplex_dij,my_ndij)) 4806 ! end if 4807 !DEBUG_ALTERNATE_ALGO 4808 4809 do ispden=1,paw_ij(iatom)%nsppol 4810 jspden=min(3-ispden,paw_ij(iatom)%nsppol) 4811 4812 ! Loops over (il,im) and (jl,jm) 4813 jl0=-1;jln0=-1;indexj=1 4814 do jlmn=1,lmn_size 4815 jl=indlmn(1,jlmn) 4816 jlpm=1+jl+indlmn(2,jlmn) 4817 jln=indlmn(5,jlmn) 4818 if (jln/=jln0) indexj=indexj+2*jl0+1 4819 j0lmn=jlmn*(jlmn-1)/2 4820 il0=-1;iln0=-1;indexi=1 4821 do ilmn=1,jlmn 4822 il=indlmn(1,ilmn) 4823 ilpm=1+il+indlmn(2,ilmn) 4824 iln=indlmn(5,ilmn) 4825 if (iln/=iln0) indexi=indexi+2*il0+1 4826 klmn=j0lmn+ilmn;klmnc=cplex_dij*(klmn-1) 4827 4828 nsym_used(:)=0 4829 4830 rotdij(:,:,:)=zero 4831 if (noncoll) rotmag(:,:,:)=zero 4832 !DEBUG_ALTERNATE_ALGO 4833 ! if (noncoll.and.lsymnew) sumrhoso(:,:)=zero 4834 !DEBUG_ALTERNATE_ALGO 4835 4836 ! Loop over symmetries 4837 do irot=1,nsym 4838 !DEBUG_ALTERNATE_ALGO 4839 ! if(lsymnew) then 4840 ! call mati3inv(symrec(:,:,irot),symrel_conv) 4841 ! call getspinrot(rprimd,spinrot,symrel_conv) 4842 ! Rspinrot(1,1)=cmplx(spinrot(1),-spinrot(4)) 4843 ! Rspinrot(1,2)=cmplx(-spinrot(3),-spinrot(2)) 4844 ! Rspinrot(2,1)=cmplx(spinrot(3),-spinrot(2)) 4845 ! Rspinrot(2,2)=cmplx(spinrot(1),spinrot(4)) 4846 ! end if 4847 !DEBUG_ALTERNATE_ALGO 4848 if ((symafm(irot)/=1).and.(.not.use_afm)) cycle 4849 kspden=ispden;if (symafm(irot)==-1) kspden=jspden 4850 iafm=1;if ((antiferro).and.(symafm(irot)==-1)) iafm=2 4851 factafm=dble(symafm(irot)) 4852 4853 nsym_used(iafm)=nsym_used(iafm)+1 4854 at_indx=indsym(4,irot,iatom_tot) 4855 4856 if (have_phase) then 4857 arg=two_pi*(qphon(1)*indsym(1,irot,iatom)+qphon(2)*indsym(2,irot,iatom) & 4858 & +qphon(3)*indsym(3,irot,iatom)) 4859 phase(1)=cos(arg);phase(2)=sin(arg) 4860 end if 4861 4862 sumdij(:,:,:)=zero 4863 if (noncoll) summag(:,:,:)=zero 4864 4865 ! Accumulate values over (mi,mj) and symmetries 4866 do mj=1,2*jl+1 4867 indexjj=indexj+mj;indexjj0=indexjj*(indexjj-1)/2 4868 do mi=1,2*il+1 4869 indexii=indexi+mi 4870 factsym(:)=one 4871 if (indexii<=indexjj) then 4872 indexk=indexjj0+indexii 4873 factsym(2)=one 4874 else 4875 indexk=indexii*(indexii-1)/2+indexjj 4876 factsym(2)=-one 4877 end if 4878 indexkc=cplex_dij*(indexk-1) 4879 indexkc_rf=indexkc+cplex_dij*lmn2_size 4880 !DEBUG_ALTERNATE_ALGO 4881 ! if (noncoll.and.lsymnew) then 4882 ! do iplex=1,cplex_dij 4883 ! if(factafm>zero) then 4884 ! dijtemp(iplex,1)=factsym(iplex)*tmp_dij(at_indx)%value(indexkc+iplex,1) 4885 ! dijtemp(iplex,2)=factsym(iplex)*tmp_dij(at_indx)%value(indexkc+iplex,2) 4886 ! else 4887 ! dijtemp(iplex,1)=factsym(iplex)*tmp_dij(at_indx)%value(indexkc+iplex,2) 4888 ! dijtemp(iplex,2)=factsym(iplex)*tmp_dij(at_indx)%value(indexkc+iplex,1) 4889 ! end if 4890 ! if(factsym(2)<zero) then ! to be changed if symafm 4891 ! dijtemp(iplex,3)=factafm*factsym(iplex)*tmp_dij(at_indx)%value(indexkc+iplex,4) 4892 ! dijtemp(iplex,4)=factafm*factsym(iplex)*tmp_dij(at_indx)%value(indexkc+iplex,3) 4893 ! else 4894 ! dijtemp(iplex,3)=factafm*factsym(iplex)*tmp_dij(at_indx)%value(indexkc+iplex,3) 4895 ! dijtemp(iplex,4)=factafm*factsym(iplex)*tmp_dij(at_indx)%value(indexkc+iplex,4) 4896 ! end if 4897 ! end do 4898 ! end if 4899 !DEBUG_ALTERNATE_ALGO 4900 4901 ! Be careful: use here R_rel^-1 in term of spherical harmonics 4902 ! which is tR_rec in term of spherical harmonics 4903 ! so, use transpose[zarot].... however, we use here zarot (??) 4904 zarot2=pawang%zarot(mi,ilpm,il+1,irot)*pawang%zarot(mj,jlpm,jl+1,irot) 4905 ! zarot2=pawang%zarot(ilpm,mi,il+1,irot)*pawang%zarot(jlpm,mj,jl+1,irot) 4906 4907 if((.not.noncoll).or.(.not.lsymnew)) then 4908 fact(1)=factsym(1);fact(2)=factsym(2)*factafm !????? What? MT 4909 sumdij(1:cplex_dij,iafm,1)=sumdij(1:cplex_dij,iafm,1) & 4910 & +fact(1:cplex_dij)*zarot2 & 4911 & *tmp_dij(at_indx)%value(indexkc+1:indexkc+cplex_dij,kspden) 4912 if (cplex_rf==2) & 4913 & sumdij(1:cplex_dij,iafm,2)=sumdij(1:cplex_dij,iafm,2) & 4914 & +fact(1:cplex_dij)*zarot2 & 4915 & *tmp_dij(at_indx)%value(indexkc_rf+1:indexkc_rf+cplex_dij,kspden) 4916 end if 4917 4918 if (noncoll.and.(.not.lsymnew)) then 4919 fact(1)=factsym(1)*factafm;fact(2)=factsym(2) 4920 do mu=1,3 4921 summag(1:cplex_dij,mu,1)=summag(1:cplex_dij,mu,1) & 4922 & +fact(1:cplex_dij)*zarot2 & 4923 & *tmp_dij(at_indx)%value(indexkc+1:indexkc+cplex_dij,1+mu) 4924 end do 4925 if (cplex_rf==2) then 4926 do mu=1,3 4927 summag(1:cplex_dij,mu,2)=summag(1:cplex_dij,mu,2) & 4928 & +fact(1:cplex_dij)*zarot2 & 4929 & *tmp_dij(at_indx)%value(indexkc_rf+1:indexkc_rf+cplex_dij,1+mu) 4930 end do 4931 end if 4932 end if 4933 !DEBUG_ALTERNATE_ALGO 4934 ! if (noncoll.and.(lsymnew)) then 4935 ! dijt(1,1)=cmplx(dijtemp(1,1),dijtemp(2,1)) 4936 ! dijt(2,2)=cmplx(dijtemp(1,2),dijtemp(2,2)) 4937 ! dijt(1,2)=cmplx(dijtemp(1,3),dijtemp(2,3)) 4938 ! dijt(2,1)=cmplx(dijtemp(1,4),dijtemp(2,4)) 4939 ! dijt2(:,:)=czero 4940 ! do i1=1,2 4941 ! do i4=1,2 4942 ! do i2=1,2 4943 ! do i3=1,2 4944 ! dijt2(i1,i4)=dijt2(i1,i4)+Rspinrot(i1,i2)*dijt(i2,i3)*conjg(Rspinrot(i4,i3)) 4945 ! end do 4946 ! end do 4947 ! end do 4948 ! end do 4949 ! do mu=1,4 4950 ! if(mu==1) then 4951 ! i1=1;i4=1 4952 ! else if(mu==2) then 4953 ! i1=2;i4=2 4954 ! else if(mu==3) then 4955 ! i1=1;i4=2 4956 ! else if(mu==4) then 4957 ! i1=2;i4=1 4958 ! end if 4959 ! sumrhoso(1,mu)=sumrhoso(1,mu)+zarot2*real(dijt2(i1,i4)) 4960 ! sumrhoso(2,mu)=sumrhoso(2,mu)+zarot2*imag(dijt2(i1,i4)) 4961 ! end do 4962 ! end if 4963 end do ! mi 4964 end do ! mj 4965 !DEBUG_ALTERNATE_ALGO 4966 4967 ! Apply phase for phonons 4968 if (have_phase) then 4969 !Remember, Dij is stored as follows: 4970 ! Dij= [Dij(2klmn-1)+i.Dij(2klmn)] 4971 ! +i.[Dij(lnm2_size+2klmn-1)+i.Dij(lmn2_size+2klmn)] 4972 !Note: have_phase=true implies cplex_rf=2 4973 if((.not.noncoll).or.(.not.lsymnew)) then 4974 do iplex=1,cplex_dij 4975 dijc(1)=sumdij(iplex,iafm,1) 4976 dijc(2)=sumdij(iplex,iafm,2) 4977 sumdij(iplex,iafm,1)=phase(1)*dijc(1)-phase(2)*dijc(2) 4978 sumdij(iplex,iafm,2)=phase(1)*dijc(2)+phase(2)*dijc(1) 4979 end do 4980 end if 4981 if (noncoll.and.(.not.lsymnew)) then 4982 do iplex=1,cplex_dij 4983 do mu=1,3 4984 dijc(1)=summag(iplex,mu,1) 4985 dijc(2)=summag(iplex,mu,2) 4986 summag(iplex,mu,1)=phase(1)*dijc(1)-phase(2)*dijc(2) 4987 summag(iplex,mu,2)=phase(1)*dijc(2)+phase(2)*dijc(1) 4988 end do 4989 end do 4990 end if 4991 !DEBUG_ALTERNATE_ALGO 4992 ! if (noncoll.and.(lsymnew) then 4993 ! do mu=1,4 4994 ! sumrhoso(1,mu)=phase(1)*sumrhoso(1,mu)-phase(2)*sumrhoso(2,mu) 4995 ! sumrhoso(2,mu)=phase(1)*sumrhoso(2,mu)+phase(2)*sumrhoso(1,mu) 4996 ! end do 4997 ! end do 4998 ! end if 4999 !DEBUG_ALTERNATE_ALGO 5000 end if 5001 5002 ! Add contribution of this rotation 5003 do iplex_rf=1,cplex_rf 5004 rotdij(1:cplex_dij,iafm,iplex_rf)=rotdij(1:cplex_dij,iafm,iplex_rf) & 5005 & +sumdij(1:cplex_dij,iafm,iplex_rf) 5006 end do 5007 if (noncoll.and.(.not.lsymnew)) then 5008 ! If non-collinear case, rotate Dij magnetization 5009 ! Should use symrel^1 but use transpose[symrec] instead 5010 do iplex_rf=1,cplex_rf 5011 do nu=1,3 5012 do mu=1,3 5013 !We need the transpose ? 5014 rotmag(1:cplex_dij,mu,iplex_rf)=rotmag(1:cplex_dij,mu,iplex_rf) & 5015 & +symrec_cart(mu,nu,irot)*summag(1:cplex_dij,nu,iplex_rf) 5016 end do 5017 end do 5018 end do 5019 end if 5020 5021 end do ! End loop over symmetries 5022 5023 if((.not.noncoll).or.(.not.lsymnew)) then 5024 ! Store new value of dij 5025 do iplex_rf=1,cplex_rf 5026 do iplex=1,cplex_dij 5027 dijnew(iplex,1,iplex_rf)=rotdij(iplex,1,iplex_rf)/nsym_used(1) 5028 if (abs(dijnew(iplex,1,iplex_rf))<=tol10) dijnew(iplex,1,iplex_rf)=zero 5029 end do 5030 end do 5031 5032 ! Antiferromagnetic case: has to fill up "down" component of dij 5033 if (antiferro.and.nsym_used(2)>0) then 5034 do iplex_rf=1,cplex_rf 5035 do iplex=1,cplex_dij 5036 dijnew(iplex,2,iplex_rf)=rotdij(iplex,2,iplex_rf)/nsym_used(2) 5037 if (abs(dijnew(iplex,2,iplex_rf))<=tol10) dijnew(iplex,2,iplex_rf)=zero 5038 end do 5039 end do 5040 end if 5041 !DEBUG_ALTERNATE_ALGO 5042 ! else if (noncoll.and.(lsymnew)) then 5043 ! do mu=1,4 5044 ! do iplex=1,cplex_dij 5045 ! dijnew(iplex,mu,1)=sumrhoso(iplex,mu)/nsym_used(1) 5046 ! if (abs(dijnew(iplex,mu,1))<=tol10) dijnew(iplex,mu,1)=zero 5047 ! end do 5048 ! end do 5049 !DEBUG_ALTERNATE_ALGO 5050 end if 5051 5052 ! Non-collinear case: store new values of Dij magnetization 5053 if (noncoll.and.(.not.lsymnew)) then 5054 ! Select on-zero elements 5055 do iplex_rf=1,cplex_rf 5056 do mu=1,3 5057 do iplex=1,cplex_dij 5058 rotmag(iplex,mu,iplex_rf)=rotmag(iplex,mu,iplex_rf)/nsym_used(1) 5059 if (abs(rotmag(iplex,mu,iplex_rf))<=tol10) rotmag(iplex,mu,iplex_rf)=zero 5060 end do 5061 end do 5062 end do 5063 ! Transfer back to Dij^{alpha,beta} 5064 if(.not.lsymnew) then 5065 !Remember: cplex_dij is 2 in that case 5066 do iplex_rf=1,cplex_rf 5067 dijnew(1,1,iplex_rf)=half*(dijnew(1,1,iplex_rf)+rotmag(1,3,iplex_rf)) 5068 dijnew(2,1,iplex_rf)=half*(dijnew(2,1,iplex_rf)+rotmag(2,3,iplex_rf)) 5069 dijnew(1,2,iplex_rf)= dijnew(1,1,iplex_rf)-rotmag(1,3,iplex_rf) 5070 dijnew(2,2,iplex_rf)= dijnew(2,1,iplex_rf)-rotmag(2,3,iplex_rf) 5071 dijnew(1,3,iplex_rf)=half*(rotmag(1,1,iplex_rf)+rotmag(2,2,iplex_rf)) 5072 dijnew(2,3,iplex_rf)=half*(rotmag(2,1,iplex_rf)-rotmag(1,2,iplex_rf)) 5073 dijnew(1,4,iplex_rf)=half*(rotmag(1,1,iplex_rf)-rotmag(2,2,iplex_rf)) 5074 dijnew(2,4,iplex_rf)=half*(rotmag(2,1,iplex_rf)+rotmag(1,2,iplex_rf)) 5075 end do 5076 end if 5077 end if 5078 ! Transfer new value of Dij in suitable pointer 5079 ii=klmnc 5080 do iplex_rf=1,cplex_rf 5081 if (option_dij==0) then 5082 paw_ij(iatom)%dij(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5083 else if (option_dij==1) then 5084 paw_ij(iatom)%dijhat(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5085 else if (option_dij==2) then 5086 paw_ij(iatom)%dijU(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5087 else if (option_dij==3) then 5088 paw_ij(iatom)%dijxc(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5089 else if (option_dij==4) then 5090 paw_ij(iatom)%dijxc_hat(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5091 else if (option_dij==5) then 5092 paw_ij(iatom)%dijxc_val(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5093 else if (option_dij==6) then 5094 paw_ij(iatom)%dijso(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5095 else if (option_dij==7) then 5096 paw_ij(iatom)%dijexxc(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5097 else if (option_dij==8) then 5098 paw_ij(iatom)%dijfr(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5099 else if (option_dij==9) then 5100 paw_ij(iatom)%dijnd(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5101 else if (option_dij==10) then 5102 paw_ij(iatom)%dijhartree(ii+1:ii+cplex_dij)=dijnew(1:cplex_dij,1,iplex_rf) 5103 else if (option_dij==11) then 5104 paw_ij(iatom)%dijfock(ii+1:ii+cplex_dij,ispden:ispden+ndij0)=dijnew(1:cplex_dij,1:ndij1,iplex_rf) 5105 end if 5106 ii=ii+lmn2_size*cplex_dij 5107 end do 5108 5109 il0=il;iln0=iln ! End loops over (il,im) and (jl,jm) 5110 end do 5111 jl0=jl;jln0=jln 5112 end do 5113 5114 end do ! ispden 5115 5116 !DEBUG_ALTERNATE_ALGO 5117 ! if (noncoll.and.lsymnew) then 5118 ! LIBPAW_DEALLOCATE(dijtemp) 5119 ! end if 5120 !DEBUG_ALTERNATE_ALGO 5121 5122 end do ! iatom 5123 5124 LIBPAW_DEALLOCATE(dijnew) 5125 if (noncoll) then 5126 LIBPAW_DEALLOCATE(symrec_cart) 5127 !DEBUG_ALTERNATE_ALGO 5128 ! if (lsymnew) then 5129 ! LIBPAW_DEALLOCATE(sumrhoso) 5130 ! end if 5131 !DEBUG_ALTERNATE_ALGO 5132 end if 5133 5134 if (paral_atom) then 5135 do iatom=1,natom 5136 LIBPAW_DEALLOCATE(tmp_dij(iatom)%value) 5137 end do 5138 LIBPAW_DATATYPE_DEALLOCATE(tmp_dij) 5139 else 5140 do iatom=1,my_natom 5141 LIBPAW_DEALLOCATE(my_tmp_dij(iatom)%value) 5142 end do 5143 LIBPAW_DATATYPE_DEALLOCATE(my_tmp_dij) 5144 end if 5145 5146 else if (ipert/=natom+1.and.ipert/=natom+10) then ! nsym>1 5147 5148 ! ********************************************************************* 5149 ! If nsym==1, only cut small components of dij 5150 5151 if (my_natom>0) then 5152 if(paw_ij(1)%nspden==2.and.paw_ij(1)%nsppol==1) then 5153 msg='In the antiferromagnetic case, nsym cannot be 1' 5154 MSG_BUG(msg) 5155 end if 5156 end if 5157 do iatom=1,my_natom 5158 do ispden=1,paw_ij(iatom)%ndij 5159 cplex_rf=paw_ij(iatom)%cplex_rf 5160 cplex_dij=paw_ij(iatom)%cplex_dij 5161 lmn2_size=paw_ij(iatom)%lmn2_size 5162 if (option_dij==0) then 5163 do klmn=1,lmn2_size*cplex_dij*cplex_rf 5164 if (abs(paw_ij(iatom)%dij(klmn,ispden))<=tol10) paw_ij(iatom)%dij(klmn,ispden)=zero 5165 end do 5166 else if (option_dij==1) then 5167 do klmn=1,lmn2_size*cplex_dij*cplex_rf 5168 if (abs(paw_ij(iatom)%dijhat(klmn,ispden))<=tol10) paw_ij(iatom)%dijhat(klmn,ispden)=zero 5169 end do 5170 else if (option_dij==2) then 5171 do klmn=1,lmn2_size*cplex_dij*cplex_rf 5172 if (abs(paw_ij(iatom)%dijU(klmn,ispden))<=tol10) paw_ij(iatom)%dijU(klmn,ispden)=zero 5173 end do 5174 else if (option_dij==3) then 5175 do klmn=1,lmn2_size*cplex_dij*cplex_rf 5176 if (abs(paw_ij(iatom)%dijxc(klmn,ispden))<=tol10) paw_ij(iatom)%dijxc(klmn,ispden)=zero 5177 end do 5178 else if (option_dij==4) then 5179 do klmn=1,lmn2_size*cplex_dij 5180 if (abs(paw_ij(iatom)%dijxc_hat(klmn,ispden))<=tol10) paw_ij(iatom)%dijxc_hat(klmn,ispden)=zero 5181 end do 5182 else if (option_dij==5) then 5183 do klmn=1,lmn2_size*cplex_dij 5184 if (abs(paw_ij(iatom)%dijxc_val(klmn,ispden))<=tol10) paw_ij(iatom)%dijxc_val(klmn,ispden)=zero 5185 end do 5186 else if (option_dij==6) then 5187 do klmn=1,lmn2_size*cplex_dij*cplex_rf 5188 if (abs(paw_ij(iatom)%dijso(klmn,ispden))<=tol10) paw_ij(iatom)%dijso(klmn,ispden)=zero 5189 end do 5190 else if (option_dij==7) then 5191 do klmn=1,lmn2_size*cplex_dij*cplex_rf 5192 if (abs(paw_ij(iatom)%dijexxc(klmn,ispden))<=tol10) paw_ij(iatom)%dijexxc(klmn,ispden)=zero 5193 end do 5194 else if (option_dij==8) then 5195 do klmn=1,lmn2_size*cplex_dij*cplex_rf 5196 if (abs(paw_ij(iatom)%dijfr(klmn,ispden))<=tol10) paw_ij(iatom)%dijfr(klmn,ispden)=zero 5197 end do 5198 else if (option_dij==9) then 5199 do klmn=1,lmn2_size*cplex_dij 5200 if (abs(paw_ij(iatom)%dijnd(klmn,ispden))<=tol10) paw_ij(iatom)%dijnd(klmn,ispden)=zero 5201 end do 5202 else if (option_dij==10.and.ispden==1) then 5203 do klmn=1,lmn2_size*cplex_rf 5204 if (abs(paw_ij(iatom)%dijhartree(klmn))<=tol10) paw_ij(iatom)%dijhartree(klmn)=zero 5205 end do 5206 else if (option_dij==11) then 5207 do klmn=1,lmn2_size*cplex_dij*cplex_rf 5208 if (abs(paw_ij(iatom)%dijfock(klmn,ispden))<=tol10) paw_ij(iatom)%dijfock(klmn,ispden)=zero 5209 end do 5210 end if 5211 end do 5212 end do 5213 5214 end if ! nsym>1 5215 5216 !********************************************************************* 5217 !Printing of Dij 5218 5219 if (abs(pawprtvol)>=1.and.option_dij==0.and.ipert/=natom+1.and.ipert/=natom+10) then 5220 wrt_mode='COLL';if (paral_atom) wrt_mode='PERS' 5221 pertstrg="DIJ";if (ipert>0) pertstrg="DIJ(1)" 5222 natinc=1;if(my_natom>1.and.pawprtvol>=0) natinc=my_natom-1 5223 write(msg, '(7a)') ch10," PAW TEST:",ch10,& 5224 & ' ========= Values of ',trim(pertstrg),' in symdij (Hartree) =========',ch10 5225 call wrtout(std_out,msg,wrt_mode) 5226 do iatom=1,my_natom,natinc 5227 iatom_tot=iatom; if (paral_atom) iatom_tot=my_atmtab(iatom) 5228 call pawdij_print_dij(paw_ij(iatom)%dij,paw_ij(iatom)%cplex_dij,paw_ij(iatom)%cplex_rf,& 5229 & iatom_tot,natom,paw_ij(iatom)%nspden,paw_ij(iatom)%nsppol,opt_prtvol=pawprtvol) 5230 end do 5231 call wrtout(std_out,"",wrt_mode) 5232 end if 5233 5234 !Destroy atom table used for parallelism 5235 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 5236 5237 !********************************************************************* 5238 !Small function: convert a symmetry operation 5239 !from reduced coordinates (integers) to cartesian coordinates (reals) 5240 contains 5241 function symdij_symcart(aprim,bprim,symred) 5242 5243 5244 !This section has been created automatically by the script Abilint (TD). 5245 !Do not modify the following lines by hand. 5246 #undef ABI_FUNC 5247 #define ABI_FUNC 'symdij_symcart' 5248 !End of the abilint section 5249 5250 implicit none 5251 real(dp) :: symdij_symcart(3,3) 5252 integer,intent(in) :: symred(3,3) 5253 real(dp),intent(in) :: aprim(3,3),bprim(3,3) 5254 integer :: ii,jj,kk 5255 real(dp) :: tmp(3,3) 5256 symdij_symcart=zero;tmp=zero 5257 do kk=1,3 5258 do jj=1,3 5259 do ii=1,3 5260 tmp(ii,jj)=tmp(ii,jj)+bprim(ii,kk)*dble(symred(jj,kk)) 5261 end do 5262 end do 5263 end do 5264 do kk=1,3 5265 do jj=1,3 5266 do ii=1,3 5267 symdij_symcart(ii,jj)=symdij_symcart(ii,jj)+aprim(ii,kk)*tmp(jj,kk) 5268 end do 5269 end do 5270 end do 5271 end function symdij_symcart 5272 5273 end subroutine symdij
m_pawdij/symdij_all [ Functions ]
[ Top ] [ m_pawdij ] [ Functions ]
NAME
symdij_all
FUNCTION
Symmetrize all contributions to PAW non-local strengths Dij
INPUTS
gprimd(3,3)=dimensional primitive translations for reciprocal space(bohr^-1). indsym(4,nsym,natom)=indirect indexing array for atom labels ipert=index of perturbation if pawrhoij is a pertubed rhoij no meaning for ground-state calculations (should be 0) mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc comm_atom=--optional-- MPI communicator over atoms my_natom=number of atoms treated by current processor natom=number of atoms in cell nsym=number of symmetry elements in space group ntypat=number of types of atoms in unit cell. paw_ij(natom)%cplex_rf=2 if exp^(-i.q.r) phase from RF at q<>0, 1 otherwise paw_ij(natom)%cplex_dij=1 if dij are REAL, 2 if they are COMPLEX paw_ij(natom)%lmn_size=number of (l,m,n) elements for the paw basis paw_ij(natom)%nspden=number of spin-density components paw_ij(natom)%nsppol=number of independant spin-density components paw_ij(natom)%dij(lmn2_size,nspden)=non-symmetrized paw dij quantities pawang <type(pawang_type)>=angular mesh discretization and related data pawprtvol=control print volume and debugging output for PAW pawtab(ntypat) <type(pawtab_type)>=paw tabulated starting data rprimd(3,3)=real space primitive translations. symafm(nsym)=(anti)ferromagnetic part of symmetry operations symrec(3,3,nsym)=symmetries of group in terms of operations on reciprocal space primitive translations
SIDE EFFECTS
paw_ij(natom)%dij???(cplex_rf*cplex_dij*lmn2_size,nspden)=symmetrized dij quantities as output
PARENTS
paw_mknewh0,screening,sigma
CHILDREN
xmpi_allgather,xmpi_allgatherv
SOURCE
5321 subroutine symdij_all(gprimd,indsym,ipert,my_natom,natom,nsym,ntypat,& 5322 & paw_ij,pawang,pawprtvol,pawtab,rprimd,symafm,symrec,& 5323 & mpi_atmtab,comm_atom) ! optional arguments (parallelism) 5324 5325 5326 !This section has been created automatically by the script Abilint (TD). 5327 !Do not modify the following lines by hand. 5328 #undef ABI_FUNC 5329 #define ABI_FUNC 'symdij_all' 5330 !End of the abilint section 5331 5332 implicit none 5333 5334 !Arguments --------------------------------------------- 5335 !scalars 5336 integer,intent(in) :: ipert,my_natom,natom,nsym,ntypat,pawprtvol 5337 integer,optional,intent(in) :: comm_atom 5338 type(pawang_type),intent(in) :: pawang 5339 !arrays 5340 integer,intent(in) :: indsym(4,nsym,natom),symafm(nsym),symrec(3,3,nsym) 5341 integer,optional,target,intent(in) :: mpi_atmtab(:) 5342 real(dp),intent(in) :: gprimd(3,3),rprimd(3,3) 5343 type(paw_ij_type),intent(inout) :: paw_ij(my_natom) 5344 type(pawtab_type),intent(in) :: pawtab(ntypat) 5345 5346 !Local variables --------------------------------------- 5347 !scalars 5348 integer,parameter :: MAX_NOPTS=12 5349 integer :: ii,option_dij,my_comm_atom,nopt 5350 logical :: my_atmtab_allocated,paral_atom 5351 character(len=500) :: msg 5352 !arrays 5353 integer :: options(MAX_NOPTS) 5354 integer,pointer :: my_atmtab(:) 5355 5356 ! ********************************************************************* 5357 5358 nopt = 0 5359 if (ANY(paw_ij(:)%has_dij==2)) then 5360 nopt = nopt + 1 5361 options(nopt) = 0 5362 end if 5363 5364 if (ANY(paw_ij(:)%has_dijhat==2)) then 5365 nopt = nopt + 1 5366 options(nopt) = 1 5367 end if 5368 5369 if (ANY(paw_ij(:)%has_dijU==2)) then 5370 nopt = nopt + 1 5371 options(nopt) = 2 5372 end if 5373 5374 if (ANY(paw_ij(:)%has_dijxc==2)) then 5375 nopt = nopt + 1 5376 options(nopt) = 3 5377 end if 5378 5379 if (ANY(paw_ij(:)%has_dijxc_hat==2)) then 5380 nopt = nopt + 1 5381 options(nopt) = 4 5382 end if 5383 5384 if (ANY(paw_ij(:)%has_dijxc_val==2)) then 5385 nopt = nopt + 1 5386 options(nopt) = 5 5387 end if 5388 5389 if (ANY(paw_ij(:)%has_dijso==2)) then 5390 nopt = nopt + 1 5391 options(nopt) = 6 5392 end if 5393 5394 if (ANY(paw_ij(:)%has_dijexxc==2)) then 5395 nopt = nopt + 1 5396 options(nopt) = 7 5397 end if 5398 5399 if (ANY(paw_ij(:)%has_dijfr==2)) then 5400 nopt = nopt + 1 5401 options(nopt) = 8 5402 end if 5403 5404 if (ANY(paw_ij(:)%has_dijnd==2)) then 5405 nopt = nopt + 1 5406 options(nopt) = 9 5407 end if 5408 5409 if (ANY(paw_ij(:)%has_dijhartree==2)) then 5410 nopt = nopt + 1 5411 options(nopt) = 10 5412 end if 5413 5414 if (ANY(paw_ij(:)%has_dijfock==2)) then 5415 nopt = nopt + 1 5416 options(nopt) = 11 5417 end if 5418 5419 if (ANY(paw_ij(:)%has_exexch_pot==2)) then 5420 nopt = nopt + 1 5421 options(nopt) = 10 5422 msg='symetrization of dij_exexch not coded!' 5423 MSG_ERROR(msg) 5424 end if 5425 5426 !Set up parallelism over atoms 5427 paral_atom=(present(comm_atom)) 5428 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 5429 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 5430 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom) 5431 5432 do ii=1,nopt 5433 option_dij = options(ii) 5434 if (paral_atom) then 5435 call symdij(gprimd,indsym,ipert,my_natom,natom,nsym,ntypat,option_dij,& 5436 & paw_ij,pawang,pawprtvol,pawtab,rprimd,symafm,symrec,& 5437 & comm_atom=my_comm_atom,mpi_atmtab=my_atmtab) 5438 else 5439 call symdij(gprimd,indsym,ipert,my_natom,natom,nsym,ntypat,option_dij,& 5440 & paw_ij,pawang,pawprtvol,pawtab,rprimd,symafm,symrec) 5441 end if 5442 end do 5443 5444 !Destroy atom table used for parallelism 5445 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 5446 5447 end subroutine symdij_all