types_xcpot.F90 5.84 KB
Newer Older
1 2 3 4 5
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------
Daniel Wortmann's avatar
Daniel Wortmann committed
6 7 8 9 10 11 12 13
!> This module defines two data-types used in the calculation of xc-potentials
!! a) the abstract t_xcpot which should be overwritten for actual implementations
!! b) the t_gradients that collects the gradients needed in GGAs
!!
!! Currently t_xcpot_inbuild implements the XC-pots directly build into FLEUR
!! and t_xcpot_libxc provides and interface to libxc.
!! In addition to overloading the t_xcpot datatype also mpi_bc_xcpot must be adjusted
!! for additional implementations.
14
MODULE m_types_xcpot
Matthias Redies's avatar
Matthias Redies committed
15
   use m_types_potden
Matthias Redies's avatar
Matthias Redies committed
16 17
   IMPLICIT NONE
   PRIVATE
Matthias Redies's avatar
Matthias Redies committed
18
   PUBLIC           :: t_xcpot,t_gradients, t_grid
Matthias Redies's avatar
Matthias Redies committed
19

Matthias Redies's avatar
Matthias Redies committed
20 21 22
   type t_grid
      real, allocatable  :: grid(:,:)
   end type t_grid
Matthias Redies's avatar
Matthias Redies committed
23
   
Matthias Redies's avatar
Matthias Redies committed
24 25
   TYPE,ABSTRACT :: t_xcpot
      REAL :: gmaxxc
Matthias Redies's avatar
Matthias Redies committed
26
      TYPE(t_potden)   :: comparison_kinED_pw(3), core_den, val_den
Matthias Redies's avatar
Matthias Redies committed
27
      TYPE(t_grid), allocatable :: mt_lapl(:), mt_kED_schr(:)
28
   CONTAINS
Matthias Redies's avatar
Matthias Redies committed
29 30
      PROCEDURE        :: vxc_is_LDA=>xcpot_vxc_is_LDA
      PROCEDURE        :: exc_is_LDA=>xcpot_exc_is_LDA
31 32 33
      PROCEDURE        :: vxc_is_gga=>xcpot_vxc_is_gga
      PROCEDURE        :: exc_is_gga=>xcpot_exc_is_gga
      PROCEDURE        :: exc_is_MetaGGA=>xcpot_exc_is_MetaGGA
Matthias Redies's avatar
Matthias Redies committed
34 35 36 37 38 39 40
      PROCEDURE        :: needs_grad=>xcpot_needs_grad
      PROCEDURE        :: is_hybrid=>xcpot_is_hybrid
      PROCEDURE        :: get_exchange_weight=>xcpot_get_exchange_weight
      PROCEDURE        :: get_vxc=>xcpot_get_vxc
      PROCEDURE        :: get_exc=>xcpot_get_exc
      PROCEDURE,NOPASS :: alloc_gradients=>xcpot_alloc_gradients
   END TYPE t_xcpot
41

Matthias Redies's avatar
Matthias Redies committed
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
   TYPE t_gradients
      !Naming convention:
      !t,u,d as last letter for total,up,down
      !agr for absolute value of gradient
      !g2r for laplacien of gradient
      !+??
      REAL,ALLOCATABLE :: agrt(:),agru(:),agrd(:)
      REAL,ALLOCATABLE :: g2ru(:),g2rd(:),gggrt(:)
      REAL,ALLOCATABLE :: gggru(:),gzgr(:),g2rt(:)
      REAL,ALLOCATABLE :: gggrd(:),grgru(:),grgrd(:)
      !These are the contracted Gradients used in libxc
      REAL,ALLOCATABLE :: sigma(:,:)
      REAL,ALLOCATABLE :: vsigma(:,:)
      REAL,ALLOCATABLE :: gr(:,:,:)
      REAL,ALLOCATABLE :: laplace(:,:)
   END TYPE t_gradients
Matthias Redies's avatar
Matthias Redies committed
58
   
59
CONTAINS
Matthias Redies's avatar
Matthias Redies committed
60 61 62 63 64 65 66 67 68 69 70 71 72 73
   ! LDA
   LOGICAL FUNCTION xcpot_vxc_is_LDA(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_vxc_is_LDA=.false.
   END FUNCTION xcpot_vxc_is_LDA

   LOGICAL FUNCTION xcpot_exc_is_LDA(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_exc_is_LDA=.false.
   END FUNCTION xcpot_exc_is_LDA

   ! GGA
74
   LOGICAL FUNCTION xcpot_vxc_is_gga(xcpot)
Matthias Redies's avatar
Matthias Redies committed
75 76
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
77 78
      xcpot_vxc_is_gga=.false.
   END FUNCTION xcpot_vxc_is_gga
Matthias Redies's avatar
Matthias Redies committed
79

80
   LOGICAL FUNCTION xcpot_exc_is_gga(xcpot)
Matthias Redies's avatar
Matthias Redies committed
81 82
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
83 84 85 86 87 88 89 90
      xcpot_exc_is_gga=.false.
   END FUNCTION xcpot_exc_is_gga

   LOGICAL FUNCTION xcpot_exc_is_MetaGGA(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_exc_is_MetaGGA=.false.
   END FUNCTION xcpot_exc_is_MetaGGA
91

Matthias Redies's avatar
Matthias Redies committed
92 93 94
   LOGICAL FUNCTION xcpot_needs_grad(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
Matthias Redies's avatar
Matthias Redies committed
95

96
      xcpot_needs_grad= xcpot%vxc_is_gga()
Matthias Redies's avatar
Matthias Redies committed
97
   END FUNCTION xcpot_needs_grad
98

Matthias Redies's avatar
Matthias Redies committed
99 100 101 102 103
   LOGICAL FUNCTION xcpot_is_hybrid(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_is_hybrid=.FALSE.
   END FUNCTION xcpot_is_hybrid
104

Matthias Redies's avatar
Matthias Redies committed
105 106 107 108 109 110 111
   FUNCTION xcpot_get_exchange_weight(xcpot) RESULT(a_ex)
      USE m_judft
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      REAL:: a_ex
      a_ex=-1
   END FUNCTION xcpot_get_exchange_weight
112

Matthias Redies's avatar
Matthias Redies committed
113
   SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh,vxc,vx,grad)
Matthias Redies's avatar
Matthias Redies committed
114
      USE m_judft
Matthias Redies's avatar
Matthias Redies committed
115 116
      IMPLICIT NONE

Matthias Redies's avatar
Matthias Redies committed
117 118 119 120 121 122 123
      CLASS(t_xcpot),INTENT(IN) :: xcpot
      INTEGER, INTENT (IN)     :: jspins
      !--> charge density
      REAL,INTENT (IN)         :: rh(:,:)
      !---> xc potential
      REAL, INTENT (OUT)       :: vxc (:,:),vx(:,:)
      TYPE(t_gradients),OPTIONAL,INTENT(INOUT)::grad
Matthias Redies's avatar
Matthias Redies committed
124 125 126 127

      vxc = 0.0
      vx  = 0.0
      call juDFT_error("Can't use XC-parrent class")
Matthias Redies's avatar
Matthias Redies committed
128
   END SUBROUTINE xcpot_get_vxc
129

Matthias Redies's avatar
Matthias Redies committed
130
   SUBROUTINE xcpot_get_exc(xcpot,jspins,rh,exc,grad,kinEnergyDen_KS)
Matthias Redies's avatar
Matthias Redies committed
131
      USE m_types_misc
132
      USE m_judft
Matthias Redies's avatar
Matthias Redies committed
133
      USE, INTRINSIC :: IEEE_ARITHMETIC
Matthias Redies's avatar
Matthias Redies committed
134 135
      IMPLICIT NONE

Matthias Redies's avatar
Matthias Redies committed
136 137
      CLASS(t_xcpot),INTENT(IN)             :: xcpot
      INTEGER, INTENT (IN)                  :: jspins
Matthias Redies's avatar
Matthias Redies committed
138
      !--> charge density
Matthias Redies's avatar
Matthias Redies committed
139
      REAL,INTENT (IN)                      :: rh(:,:)
Matthias Redies's avatar
Matthias Redies committed
140
      !--> kinetic energy density
Matthias Redies's avatar
Matthias Redies committed
141
      !---> xc energy density
Matthias Redies's avatar
Matthias Redies committed
142 143
      REAL, INTENT (OUT)                    :: exc (:)
      TYPE(t_gradients),OPTIONAL,INTENT(IN) :: grad
Matthias Redies's avatar
Matthias Redies committed
144
      REAL, INTENT(IN), OPTIONAL            :: kinEnergyDen_KS(:,:)
Matthias Redies's avatar
Matthias Redies committed
145 146 147

      exc = 0.0
      call juDFT_error("Can't use XC-parrent class")
Matthias Redies's avatar
Matthias Redies committed
148
   END SUBROUTINE xcpot_get_exc
149

Matthias Redies's avatar
Matthias Redies committed
150
   SUBROUTINE xcpot_alloc_gradients(ngrid,jspins,grad)
Matthias Redies's avatar
Matthias Redies committed
151 152
      IMPLICIT NONE

Matthias Redies's avatar
Matthias Redies committed
153 154
      INTEGER, INTENT (IN)         :: jspins,ngrid
      TYPE(t_gradients),INTENT(INOUT):: grad
155

Matthias Redies's avatar
Matthias Redies committed
156 157 158 159 160 161 162 163 164 165 166
      IF (allocated(grad%agrt)) THEN
         DEALLOCATE(grad%agrt,grad%agru,grad%agrd)
         DEALLOCATE(grad%g2ru,grad%g2rd,grad%gggrt)
         DEALLOCATE(grad%gggru,grad%gzgr,grad%g2rt)
         DEALLOCATE(grad%gggrd,grad%grgru,grad%grgrd)
      ENDIF
      !For the in-build xc-pots
      ALLOCATE(grad%agrt(ngrid),grad%agru(ngrid),grad%agrd(ngrid))
      ALLOCATE(grad%g2ru(ngrid),grad%g2rd(ngrid),grad%gggrt(ngrid))
      ALLOCATE(grad%gggru(ngrid),grad%gzgr(ngrid),grad%g2rt(ngrid))
      ALLOCATE(grad%gggrd(ngrid),grad%grgru(ngrid),grad%grgrd(ngrid))
Matthias Redies's avatar
Matthias Redies committed
167
  END SUBROUTINE xcpot_alloc_gradients
168

169
END MODULE m_types_xcpot