libxc_postprocess_gga.f90 3.94 KB
Newer Older
1 2 3 4 5 6 7 8
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_libxc_postprocess_gga
CONTAINS

Matthias Redies's avatar
Matthias Redies committed
9
   SUBROUTINE libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad, atom_num)
10 11
      USE m_mt_tofrom_grid
      USE m_types
Matthias Redies's avatar
Matthias Redies committed
12 13
      use m_judft_string

14 15 16 17 18 19 20
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN)   :: xcpot
      TYPE(t_atoms),INTENT(IN)    :: atoms
      TYPE(t_sphhar),INTENT(IN)   :: sphhar
      INTEGER,INTENT(IN)          :: n
      REAL,INTENT(INOUT)          :: v_xc(:,:)
      TYPE(t_gradients),INTENT(IN):: grad
Matthias Redies's avatar
Matthias Redies committed
21
      INTEGER, OPTIONAL           :: atom_num
22

23 24 25
      INTEGER :: nsp,n_sigma,i
      REAL,ALLOCATABLE:: vsigma(:,:),vsigma_mt(:,:,:)
      TYPE(t_gradients)::grad_vsigma
Matthias Redies's avatar
Matthias Redies committed
26
      character(len=:), allocatable :: fname
27

28 29 30 31 32
      n_sigma=MERGE(1,3,SIZE(v_xc,2)==1) !Number of contracted gradients in libxc 1 for non-spin-polarized, 3 otherwise
      nsp=SIZE(v_xc,1) !no of points
      ALLOCATE(vsigma(nsp,n_sigma),vsigma_mt(atoms%jri(n),0:sphhar%nlhd,n_sigma))
      vsigma_mt=0.0
      vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
33
      CALL mt_from_grid(atoms,sphhar,n,n_sigma,vsigma,vsigma_mt)
34 35 36 37
      DO i=1,atoms%jri(n)
         vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2
      ENDDO
      ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
38
      CALL mt_to_grid(xcpot,n_sigma,atoms,sphhar,vsigma_mt,n,grad=grad_vsigma)
39

40 41
      CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
   END SUBROUTINE libxc_postprocess_gga_mt
42

43 44 45
   SUBROUTINE libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
      USE m_pw_tofrom_grid
      USE m_types
46

47 48 49 50 51 52
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN)   :: xcpot
      TYPE(t_stars),INTENT(IN)    :: stars
      TYPE(t_cell),INTENT(IN)     :: cell
      REAL,INTENT(INOUT)          :: v_xc(:,:)
      TYPE(t_gradients),INTENT(IN):: grad
53

54 55 56 57
      COMPLEX,ALLOCATABLE:: vsigma_g(:,:)
      REAL,ALLOCATABLE:: vsigma(:,:)
      TYPE(t_gradients)::grad_vsigma
      INTEGER :: nsp,n_sigma
58

59 60 61 62 63 64 65 66
      nsp=SIZE(v_xc,1) !no of points
      n_sigma=MERGE(1,3,SIZE(v_xc,2)==1) !See in _mt routine
      ALLOCATE(vsigma_g(stars%ng3,n_sigma),vsigma(nsp,n_sigma)); vsigma_g=0.0
      vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
      CALL pw_from_grid(xcpot,stars,.FALSE.,vsigma,vsigma_g)
      !vsigma_g(:,1)=vsigma_g(:,1)*stars%nstr(:)
      ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
      CALL pw_to_grid(xcpot,n_sigma,.false.,stars,cell,vsigma_g,grad_vsigma)
67

68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
      CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
   END SUBROUTINE libxc_postprocess_gga_pw

   SUBROUTINE libxc_postprocess_gga(vsigma,grad,grad_vsigma,v_xc)
      USE m_types
      IMPLICIT NONE
      REAL,INTENT(IN)             :: vsigma(:,:)
      TYPE(t_gradients),INTENT(IN):: grad,grad_vsigma
      REAL,INTENT(INOUT)          :: v_xc(:,:)
      INTEGER:: i
      IF (SIZE(v_xc,2)==1) THEN !Single spin
         DO i=1,SIZE(v_xc,1) !loop over points
            v_xc(i,1)=v_xc(i,1)-2*dot_PRODUCT(grad_vsigma%gr(:,i,1),grad%gr(:,i,1))-2*vsigma(i,1)*grad%laplace(i,1)
         ENDDO
      ELSE  !two spins
         DO i=1,SIZE(v_xc,1) !loop over points
            v_xc(i,1)=v_xc(i,1)-2*dot_PRODUCT(grad_vsigma%gr(:,i,1),grad%gr(:,i,1))-2*vsigma(i,1)*grad%laplace(i,1)-&
                       dot_PRODUCT(grad_vsigma%gr(:,i,2),grad%gr(:,i,2))-vsigma(i,2)*grad%laplace(i,2)
            v_xc(i,2)=v_xc(i,2)-2*dot_PRODUCT(grad_vsigma%gr(:,i,3),grad%gr(:,i,2))-2*vsigma(i,3)*grad%laplace(i,2)-&
                       dot_PRODUCT(grad_vsigma%gr(:,i,2),grad%gr(:,i,1))-vsigma(i,2)*grad%laplace(i,1)
         ENDDO
      END IF

   END SUBROUTINE libxc_postprocess_gga
92

93
END MODULE m_libxc_postprocess_gga