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 add_vuspsi (lda, n, m, psi, hpsi )
|
2003-01-20 05:58:50 +08:00
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! This routine applies the Ultra-Soft Hamiltonian to a
|
|
|
|
|
! vector psi and puts the result in hpsi.
|
|
|
|
|
! Requires the products of psi with all beta functions
|
|
|
|
|
! in array becp(nkb,m) (calculated by ccalbec)
|
|
|
|
|
! input:
|
|
|
|
|
! lda leading dimension of arrays psi, spsi
|
|
|
|
|
! n true dimension of psi, spsi
|
|
|
|
|
! m number of states psi
|
2003-02-08 00:04:36 +08:00
|
|
|
! psi
|
2003-01-20 05:58:50 +08:00
|
|
|
! output:
|
|
|
|
|
! hpsi V_US*psi is added to hpsi
|
|
|
|
|
!
|
|
|
|
|
#include "machine.h"
|
2003-02-08 00:04:36 +08:00
|
|
|
use pwcom
|
|
|
|
|
use becmod
|
2003-01-20 05:58:50 +08:00
|
|
|
implicit none
|
|
|
|
|
!
|
|
|
|
|
! First the dummy variables
|
|
|
|
|
!
|
|
|
|
|
integer :: lda, n, m
|
2003-02-08 00:04:36 +08:00
|
|
|
complex(kind=DP) :: psi (lda, m), hpsi (lda, m)
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! here the local variables
|
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
integer :: jkb, ikb, ih, jh, na, nt, ijkb0, ibnd
|
2003-01-20 05:58:50 +08:00
|
|
|
! counters
|
2003-02-08 00:04:36 +08:00
|
|
|
complex(kind=DP), allocatable :: ps (:,:)
|
2003-01-20 05:58:50 +08:00
|
|
|
! the product vkb and psi
|
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
if (nkb.eq.0) return
|
|
|
|
|
call start_clock ('add_vuspsi')
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
allocate (ps( nkb, m))
|
2003-01-20 05:58:50 +08:00
|
|
|
ps (:,:) = (0.d0, 0.d0)
|
2003-02-08 00:04:36 +08:00
|
|
|
ijkb0 = 0
|
|
|
|
|
do nt = 1, ntyp
|
|
|
|
|
do na = 1, nat
|
|
|
|
|
if (ityp (na) .eq.nt) then
|
2003-01-20 05:58:50 +08:00
|
|
|
do ibnd = 1, m
|
2003-02-08 00:04:36 +08:00
|
|
|
do jh = 1, nh (nt)
|
|
|
|
|
jkb = ijkb0 + jh
|
|
|
|
|
do ih = 1, nh (nt)
|
|
|
|
|
ikb = ijkb0 + ih
|
2003-01-20 05:58:50 +08:00
|
|
|
ps (ikb, ibnd) = ps (ikb, ibnd) + &
|
|
|
|
|
deeq(ih,jh,na,current_spin) * becp(jkb,ibnd)
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
2003-02-08 00:04:36 +08:00
|
|
|
ijkb0 = ijkb0 + nh (nt)
|
2003-01-20 05:58:50 +08:00
|
|
|
endif
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
call ZGEMM ('N', 'N', n, m, nkb, (1.d0, 0.d0) , vkb, &
|
|
|
|
|
lda, ps, nkb, (1.d0, 0.d0) , hpsi, lda)
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
deallocate (ps)
|
|
|
|
|
call stop_clock ('add_vuspsi')
|
|
|
|
|
return
|
2003-01-20 05:58:50 +08:00
|
|
|
end subroutine add_vuspsi
|
|
|
|
|
|
