libxc_postprocess_gga.f90 4.81 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
!--------------------------------------------------------------------------------
! 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
  
 

  SUBROUTINE libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad)
    USE m_mt_tofrom_grid
    USE m_types
    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

22
    INTEGER :: nsp,n_sigma,i
23
    REAL,ALLOCATABLE:: vsigma(:,:),vsigma_mt(:,:,:)
24
    TYPE(t_gradients)::grad_vsigma
25 26 27
    
    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
28
    ALLOCATE(vsigma(nsp,n_sigma),vsigma_mt(atoms%jri(n),0:sphhar%nlhd,n_sigma))
29
    vsigma_mt=0.0
30
    vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
31
    CALL mt_from_grid(atoms,sphhar,nsp/atoms%jmtd,n,n_sigma,vsigma,vsigma_mt)
32 33 34
    DO i=1,atoms%jri(n)
        vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2
    ENDDO
35 36
    ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
    CALL mt_to_grid(xcpot,n_sigma,atoms,sphhar,vsigma_mt,nsp/atoms%jmtd,n,grad=grad_vsigma)
37
    
38
    CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
39 40 41 42 43 44 45 46 47 48 49 50 51 52
  END SUBROUTINE libxc_postprocess_gga_mt

 SUBROUTINE libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
    USE m_pw_tofrom_grid
    USE m_types
    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

    COMPLEX,ALLOCATABLE:: vsigma_g(:,:)
    REAL,ALLOCATABLE:: vsigma(:,:)
53
    TYPE(t_gradients)::grad_vsigma
54 55 56 57
    INTEGER :: nsp,n_sigma
    
    nsp=SIZE(v_xc,1) !no of points
    n_sigma=MERGE(1,3,SIZE(v_xc,2)==1) !See in _mt routine
58
    ALLOCATE(vsigma_g(stars%ng3,n_sigma),vsigma(nsp,n_sigma));vsigma_g=0.0
59 60
    vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
    CALL pw_from_grid(xcpot,stars,.FALSE.,vsigma,vsigma_g)
61
    !vsigma_g(:,1)=vsigma_g(:,1)*stars%nstr(:)
62 63
    ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
    CALL pw_to_grid(xcpot,n_sigma,.false.,stars,cell,vsigma_g,grad_vsigma)
64
    
65
    CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
66 67 68

  END SUBROUTINE libxc_postprocess_gga_pw

69 70 71 72 73 74 75 76 77 78 79 80 81

  SUBROUTINE libxc_postprocess_gga_pw_alt(xcpot,stars,cell,v_xc,grad)
    USE m_pw_tofrom_grid
    USE m_types
    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

    COMPLEX,ALLOCATABLE:: vsigma_g(:,:)
    REAL,ALLOCATABLE:: vsigma(:,:)
82
    TYPE(t_gradients)::grad_vsigma
83 84 85 86 87
    INTEGER :: nsp,n_sigma,i
    
    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   
88
    ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
89 90 91 92 93
    DO i=1,3
       vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
       !Multiply with gradient
       vsigma(:,1)=vsigma(:,1)*grad%gr(i,:,1)
       CALL pw_from_grid(xcpot,stars,.FALSE.,vsigma,vsigma_g)
94 95
       CALL pw_to_grid(xcpot,n_sigma,.FALSE.,stars,cell,vsigma_g,grad_vsigma)
       v_xc(:,1)=v_xc(:,1)-2*grad_vsigma%gr(i,:,1)
96 97 98
    ENDDO
  
  END SUBROUTINE libxc_postprocess_gga_pw_alt
99
  
100
  SUBROUTINE libxc_postprocess_gga(vsigma,grad,grad_vsigma,v_xc)
101 102 103
    USE m_types
    IMPLICIT NONE
    REAL,INTENT(IN)             :: vsigma(:,:)
104
    TYPE(t_gradients),INTENT(IN):: grad,grad_vsigma
105 106 107 108
    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
109
          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)
110 111 112
       ENDDO
    ELSE  !two spins
       DO i=1,SIZE(v_xc,1) !loop over points
113 114 115 116
          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)
117 118 119 120
       ENDDO
    END IF
    
  END SUBROUTINE libxc_postprocess_gga
121 122

  
123
END MODULE m_libxc_postprocess_gga