src/genvmatk.f90

   1
   2 ! Copyright (C) 2007 J. K. Dewhurst, S. Sharma and C. Ambrosch-Draxl.
   3 ! This file is distributed under the terms of the GNU General Public License.
   4 ! See the file COPYING for license details.
   5
   6 subroutine genvmatk(vmt,vir,wfmt,wfir,vmat)
   7 use modmain
   8 implicit none
   9 ! arguments
  10 real(8), intent(in) :: vmt(lmmaxvr,nrcmtmax,natmtot)
  11 real(8), intent(in) :: vir(ngrtot)
  12 complex(8), intent(in) :: wfmt(lmmaxvr,nrcmtmax,natmtot,nspinor,nstsv)
  13 complex(8), intent(in) :: wfir(ngrtot,nspinor,nstsv)
  14 complex(8), intent(out) :: vmat(nstsv,nstsv)
  15 ! local variables
  16 integer is,ia,ias,nr,irc
  17 integer ispn,ist,jst
  18 real(8) t1
  19 complex(8) zt1
  20 ! allocatable arrays
  21 real(8), allocatable :: rfir(:)
  22 complex(8), allocatable :: zfmt(:,:)
  23 complex(8), allocatable :: zfir(:)
  24 ! external functions
  25 complex(8) zfmtinp,zdotc
  26 external zfmtinp,zdotc
  27 ! allocate local arrays
  28 allocate(rfir(ngrtot))
  29 allocate(zfmt(lmmaxvr,nrcmtmax))
  30 allocate(zfir(ngrtot))
  31 ! zero the matrix elements
  32 vmat(:,:)=0.d0
  33 !-------------------------!
  34 !     muffin-tin part     !
  35 !-------------------------!
  36 do jst=1,nstsv
  37   do is=1,nspecies
  38     nr=nrcmt(is)
  39     do ia=1,natoms(is)
  40       ias=idxas(ia,is)
  41       do ispn=1,nspinor
  42 ! apply potential to wavefunction
  43         do irc=1,nr
  44           zfmt(:,irc)=vmt(:,irc,ias)*wfmt(:,irc,ias,ispn,jst)
  45         end do
  46         do ist=1,jst
  47 ! compute inner product (functions are in spherical coordinates)
  48           zt1=zfmtinp(.false.,lmaxvr,nr,rcmt(1,is),lmmaxvr, &
  49            wfmt(1,1,ias,ispn,ist),zfmt)
  50           vmat(ist,jst)=vmat(ist,jst)+zt1
  51         end do
  52       end do
  53     end do
  54   end do
  55 end do
  56 !---------------------------!
  57 !     interstitial part     !
  58 !---------------------------!
  59 rfir(:)=vir(:)*cfunir(:)
  60 t1=omega/dble(ngrtot)
  61 do jst=1,nstsv
  62   do ispn=1,nspinor
  63 ! apply potential to wavefunction
  64     zfir(:)=rfir(:)*wfir(:,ispn,jst)
  65     do ist=1,jst
  66       zt1=zdotc(ngrtot,wfir(1,ispn,ist),1,zfir,1)
  67       vmat(ist,jst)=vmat(ist,jst)+t1*zt1
  68     end do
  69   end do
  70 end do
  71 ! lower triangular part
  72 do ist=1,nstsv
  73   do jst=1,ist-1
  74     vmat(ist,jst)=conjg(vmat(jst,ist))
  75   end do
  76 end do
  77 deallocate(rfir,zfmt,zfir)
  78 return
  79 end subroutine
  80