2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! Copyright (C) 2001 PWSCF group
|
|
|
|
|
! This file is distributed under the terms of the
|
|
|
|
|
! GNU General Public License. See the file `License'
|
|
|
|
|
! in the root directory of the present distribution,
|
|
|
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
|
|
|
!
|
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
subroutine orthoatwfc
|
2003-01-20 05:58:50 +08:00
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! This routine is meant to orthogonalize all the atomic wfcs. This is
|
|
|
|
|
! useful when we want to compute the occupation of the atomic orbitals
|
|
|
|
|
! in order to make lda+U calculations
|
|
|
|
|
!
|
|
|
|
|
#include "machine.h"
|
2003-02-08 00:04:36 +08:00
|
|
|
use pwcom
|
|
|
|
|
use becmod
|
2003-01-20 05:58:50 +08:00
|
|
|
#ifdef PARA
|
|
|
|
|
use para
|
|
|
|
|
#endif
|
|
|
|
|
implicit none
|
|
|
|
|
integer :: ik, ibnd, info, i, j, k, na, nb, nt, isym, n, ntemp, m, &
|
|
|
|
|
l, lm, ltot, ntot
|
2003-02-08 00:04:36 +08:00
|
|
|
integer, allocatable :: nwfc (:), ml (:)
|
2003-01-20 05:58:50 +08:00
|
|
|
! the k point under consideration
|
|
|
|
|
! counter on bands
|
|
|
|
|
! number of wfc of atom na
|
|
|
|
|
! corrispondence m <-> natomwfc
|
2003-02-08 00:04:36 +08:00
|
|
|
integer :: nchi_, lchi_ (nchix)
|
|
|
|
|
logical :: exst
|
|
|
|
|
real(kind=DP) :: t0, scnds
|
2003-01-20 05:58:50 +08:00
|
|
|
! cpu time spent
|
|
|
|
|
logical :: orthogonalize_wfc
|
|
|
|
|
|
|
|
|
|
complex(kind=DP) :: ZDOTC, temp, t (5)
|
2003-02-08 00:04:36 +08:00
|
|
|
complex(kind=DP) , allocatable :: wfcatom (:,:), work (:,:), overlap (:,:)
|
|
|
|
|
real(kind=DP) , allocatable :: e (:)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
t0 = scnds ()
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
allocate (wfcatom( npwx, natomwfc))
|
|
|
|
|
allocate (overlap( natomwfc , natomwfc))
|
|
|
|
|
allocate (work ( natomwfc , natomwfc))
|
|
|
|
|
allocate (e ( natomwfc))
|
|
|
|
|
allocate (ml ( natomwfc))
|
|
|
|
|
allocate (nwfc ( nat))
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
|
orthogonalize_wfc = .false.
|
|
|
|
|
if (orthogonalize_wfc) then
|
|
|
|
|
write (6,*) 'Atomic wfc used in LDA+U are orthogonalized'
|
|
|
|
|
else
|
|
|
|
|
write (6,*) 'Atomic wfc used in LDA+U are NOT orthogonalized'
|
|
|
|
|
end if
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
if (nks.gt.1) rewind (iunigk)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
do ik = 1, nks
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
if (nks.gt.1) read (iunigk) npw, igk
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
|
overlap(:,:) = (0.d0,0.d0)
|
|
|
|
|
work(:,:) = (0.d0,0.d0)
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
call atomic_wfc (ik, wfcatom)
|
|
|
|
|
call init_us_2 (npw, igk, xk (1, ik), vkb)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
call ccalbec (nkb, npwx, npw, natomwfc, becp, vkb, wfcatom)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
call s_psi (npwx, npw, natomwfc, wfcatom, swfcatom)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
|
if (orthogonalize_wfc) then
|
|
|
|
|
!
|
|
|
|
|
! calculate overlap matrix
|
|
|
|
|
!
|
|
|
|
|
call ZGEMM ('c', 'n', natomwfc, natomwfc, npw, (1.d0, 0.d0) , &
|
|
|
|
|
wfcatom, npwx, swfcatom, npwx, (0.d0, 0.d0) , overlap, natomwfc)
|
|
|
|
|
#ifdef PARA
|
2003-02-08 00:04:36 +08:00
|
|
|
call reduce (2 * natomwfc * natomwfc, overlap)
|
2003-01-20 05:58:50 +08:00
|
|
|
#endif
|
|
|
|
|
!
|
|
|
|
|
! find O^-.5
|
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
call cdiagh (natomwfc, overlap, natomwfc, e, work)
|
|
|
|
|
do i = 1, natomwfc
|
|
|
|
|
e (i) = 1.d0 / dsqrt (e (i) )
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
2003-02-08 00:04:36 +08:00
|
|
|
do i = 1, natomwfc
|
|
|
|
|
do j = i, natomwfc
|
|
|
|
|
temp = (0.d0, 0.d0)
|
|
|
|
|
do k = 1, natomwfc
|
|
|
|
|
temp = temp + e (k) * work (j, k) * conjg (work (i, k) )
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
2003-02-08 00:04:36 +08:00
|
|
|
overlap (i, j) = temp
|
|
|
|
|
if (j.ne.i) overlap (j, i) = conjg (temp)
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
!
|
|
|
|
|
! trasform atomic orbitals O^-.5 psi
|
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
do i = 1, npw
|
|
|
|
|
call setv (2 * natomwfc, 0.d0, work, 1)
|
2003-01-20 05:58:50 +08:00
|
|
|
call ZGEMV ('n', natomwfc, natomwfc, (1.d0, 0.d0) , overlap, &
|
|
|
|
|
natomwfc, swfcatom (i, 1) , npwx, (0.d0, 0.d0) , work, 1)
|
2003-02-08 00:04:36 +08:00
|
|
|
call ZCOPY (natomwfc, work, 1, swfcatom (i, 1), npwx)
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
call davcio (swfcatom, nwordatwfc, iunat, ik, 1)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
|
enddo
|
2003-02-08 00:04:36 +08:00
|
|
|
deallocate (nwfc)
|
|
|
|
|
deallocate (ml)
|
|
|
|
|
deallocate (overlap)
|
|
|
|
|
deallocate (work)
|
|
|
|
|
deallocate (e)
|
|
|
|
|
deallocate (wfcatom)
|
|
|
|
|
return
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
|
end subroutine orthoatwfc
|
|
|
|
|
|
