libxc_postprocess_gga.f90 4.84 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
24
25
26
27
    REAL,ALLOCATABLE:: vsigma(:,:),vsigma_mt(:,:,:)
    TYPE(t_gradients)::grad_sigma
    
    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
    ALLOCATE(grad_sigma%gr(3,nsp,n_sigma))
36
    CALL mt_to_grid(xcpot,n_sigma,atoms,sphhar,vsigma_mt,nsp/atoms%jmtd,n,grad=grad_sigma)
37
    
38
    CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_sigma,v_xc)
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
  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(:,:)
    TYPE(t_gradients)::grad_sigma
    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
    ALLOCATE(grad_sigma%gr(3,nsp,n_sigma))
63
    CALL pw_to_grid(xcpot,n_sigma,.false.,stars,cell,vsigma_g,grad_sigma)
64
    
65
    CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_sigma,v_xc)
66
67
68

  END SUBROUTINE libxc_postprocess_gga_pw

69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

  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(:,:)
    TYPE(t_gradients)::grad_sigma
    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   
    ALLOCATE(grad_sigma%gr(3,nsp,n_sigma))
    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)
       CALL pw_to_grid(xcpot,n_sigma,.FALSE.,stars,cell,vsigma_g,grad_sigma)
       v_xc(:,1)=v_xc(:,1)-2*grad_sigma%gr(i,:,1)
    ENDDO
  
  END SUBROUTINE libxc_postprocess_gga_pw_alt
99
100
101
102
103
104
105
106
107
108
  
  SUBROUTINE libxc_postprocess_gga(vsigma,grad,grad_sigma,v_xc)
    USE m_types
    IMPLICIT NONE
    REAL,INTENT(IN)             :: vsigma(:,:)
    TYPE(t_gradients),INTENT(IN):: grad,grad_sigma
    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
          IF (ALL(ABS(grad%gr(:,i,1))<1E-10)) CYCLE
110
          v_xc(i,1)=v_xc(i,1)-2*dot_PRODUCT(grad_sigma%gr(:,i,1),grad%gr(:,i,1))-2*vsigma(i,1)*grad%laplace(i,1)
111
112
113
114
115
116
117
118
119
120
121
       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_sigma%gr(:,i,1),grad%gr(:,i,1))-2*vsigma(i,1)*grad%laplace(i,1)-&
               dot_PRODUCT(grad_sigma%gr(:,i,2),grad%gr(:,i,2))-vsigma(i,2)*grad%laplace(i,2)
          v_xc(i,1)=v_xc(i,2)-2*dot_PRODUCT(grad_sigma%gr(:,i,3),grad%gr(:,i,2))-2*vsigma(i,3)*grad%laplace(i,2)-&
               dot_PRODUCT(grad_sigma%gr(:,i,2),grad%gr(:,i,1))-vsigma(i,2)*grad%laplace(i,1)
       ENDDO
    END IF
    
  END SUBROUTINE libxc_postprocess_gga
122
123

  
124
END MODULE m_libxc_postprocess_gga