File: genvfxc.f90

package info (click to toggle)
elkcode 5.4.24-2
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 12,840 kB
  • sloc: f90: 48,415; fortran: 22,457; perl: 965; makefile: 384; sh: 369; python: 105; ansic: 67
file content (74 lines) | stat: -rw-r--r-- 1,736 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

! Copyright (C) 2011 S. Sharma, J. K. Dewhurst and E. K. U. Gross.
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.

subroutine genvfxc(tq0,t3hw,gclgq,nm,vchi0,eps0,epsi,vfxc)
use modmain
use modtddft
implicit none
! arguments
logical, intent(in) :: tq0,t3hw
real(8), intent(in) :: gclgq(ngrf)
integer, intent(in) :: nm
complex(8), intent(in) :: vchi0(nm,nm,nwrf)
complex(8), intent(in) :: eps0(nm,nm,nwrf)
complex(8), intent(in) :: epsi(nm,nm,nwrf)
complex(8), intent(out) :: vfxc(nm,nm,nwrf)
! local variables
integer iw,i,j
complex(8) z1
! allocatable arrays
complex(8), allocatable :: a(:,:)
! compute v^(-1/2) f_xc v^(-1/2)
select case(fxctype(1))
case(0,1)
! RPA
  vfxc(:,:,:)=0.d0
  return
case(3)
! ALDA
  if (tq0.and.t3hw) then
    call genvfxcg(gclgq,nm,vfxc(3,3,1))
! the head and wings are zero
    vfxc(1:3,:,:)=0.d0
    vfxc(4:,1:3,:)=0.d0
  else
    call genvfxcg(gclgq,nm,vfxc)
  end if
case(200)
! long-range contribution with dynamic correlations
  vfxc(:,:,:)=0.d0
  do i=1,nm
    vfxc(i,i,:)=-(fxclrc(1)+fxclrc(2)*dble(wrf(:))**2)/fourpi
  end do
case(210,211)
! bootstrap
  vfxc(:,:,:)=0.d0
  if (tq0.and.t3hw) then
    z1=(eps0(1,1,1)+eps0(2,2,1)+eps0(3,3,1))/3.d0
  else
    z1=eps0(1,1,1)
  end if
  z1=-1.d0/(z1-1.d0)
  do i=1,nm
    do j=1,nm
      vfxc(i,j,:)=z1*epsi(i,j,1)
    end do
  end do
case default
  write(*,*)
  write(*,'("Error(genvfxc): fxctype not defined : ",3I8)') fxctype
  write(*,*)
  stop
end select
! right multiply by v^1/2 chi0 v^1/2
allocate(a(nm,nm))
do iw=1,nwrf
  a(:,:)=vfxc(:,:,iw)
  call zgemm('N','N',nm,nm,nm,zone,a,nm,vchi0(:,:,iw),nm,zzero,vfxc(:,:,iw),nm)
end do
deallocate(a)
return
end subroutine