types_xcpot.F90 7.85 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.
Daniel Wortmann's avatar
Daniel Wortmann committed
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
Matthias Redies's avatar
Matthias Redies committed
19

Matthias Redies's avatar
Matthias Redies committed
20
   TYPE t_kinED
Matthias Redies's avatar
Matthias Redies committed
21
      logical             :: set
Matthias Redies's avatar
Matthias Redies committed
22 23 24 25 26 27
      real, allocatable   :: is(:,:)   ! (nsp*jmtd, jspins)
      real, allocatable   :: mt(:,:,:) ! (nsp*jmtd, jspins, local num of types)
   contains
      procedure           :: alloc_mt => kED_alloc_mt
   END TYPE t_kinED

Matthias Redies's avatar
Matthias Redies committed
28 29
   TYPE,ABSTRACT :: t_xcpot
      REAL :: gmaxxc
30
      TYPE(t_potden)   :: core_den, val_den
Matthias Redies's avatar
Matthias Redies committed
31
      TYPE(t_kinED)    :: kinED
Daniel Wortmann's avatar
Daniel Wortmann committed
32
   CONTAINS
Matthias Redies's avatar
Matthias Redies committed
33 34
      PROCEDURE        :: vxc_is_LDA => xcpot_vxc_is_LDA
      PROCEDURE        :: vxc_is_GGA => xcpot_vxc_is_GGA
35 36 37

      PROCEDURE        :: vx_is_LDA     => xcpot_vx_is_LDA
      PROCEDURE        :: vx_is_GGA     => xcpot_vx_is_GGA
Matthias Redies's avatar
Matthias Redies committed
38
      PROCEDURE        :: vx_is_MetaGGA => xcpot_vx_is_MetaGGA
39

Matthias Redies's avatar
Matthias Redies committed
40 41
      PROCEDURE        :: vc_is_LDA => xcpot_vc_is_LDA
      PROCEDURE        :: vc_is_GGA => xcpot_vc_is_GGA
42 43 44 45 46

      PROCEDURE        :: exc_is_LDA     => xcpot_exc_is_LDA
      PROCEDURE        :: exc_is_GGA     => xcpot_exc_is_GGA
      PROCEDURE        :: exc_is_MetaGGA => xcpot_exc_is_MetaGGA

Matthias Redies's avatar
Matthias Redies committed
47 48
      PROCEDURE        :: needs_grad => xcpot_needs_grad
      PROCEDURE        :: is_hybrid  => xcpot_is_hybrid
49 50 51 52 53

      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
Matthias Redies's avatar
Matthias Redies committed
54
   END TYPE t_xcpot
Daniel Wortmann's avatar
Daniel Wortmann committed
55

Matthias Redies's avatar
Matthias Redies committed
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
   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
72
CONTAINS
Matthias Redies's avatar
Matthias Redies committed
73 74 75 76 77
   subroutine kED_alloc_mt(kED,nsp_x_jmtd, jspins, n_start, n_types, n_stride)
      implicit none
      class(t_kinED), intent(inout)   :: kED
      integer, intent(in)            :: nsp_x_jmtd, jspins, n_start, n_types, n_stride
      integer                        :: cnt, n
Matthias Redies's avatar
Matthias Redies committed
78
      
Matthias Redies's avatar
Matthias Redies committed
79 80 81 82 83 84 85 86 87
      if(.not. allocated(kED%mt)) then
         cnt = 0
         do n = n_start,n_types,n_stride
            cnt = cnt + 1
         enddo
         allocate(kED%mt(nsp_x_jmtd, jspins, cnt))
      endif
   end subroutine kED_alloc_mt

Matthias Redies's avatar
Matthias Redies committed
88
   ! LDA
89 90 91 92 93 94 95 96 97 98 99 100
   LOGICAL FUNCTION xcpot_vc_is_LDA(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_vc_is_LDA=.false.
   END FUNCTION xcpot_vc_is_LDA

   LOGICAL FUNCTION xcpot_vx_is_LDA(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_vx_is_LDA=.false.
   END FUNCTION xcpot_vx_is_LDA
   
Matthias Redies's avatar
Matthias Redies committed
101 102 103
   LOGICAL FUNCTION xcpot_vxc_is_LDA(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
104
      xcpot_vxc_is_LDA = xcpot%vx_is_LDA() .and. xcpot%vc_is_LDA()
Matthias Redies's avatar
Matthias Redies committed
105 106 107 108 109 110 111 112 113
   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
114 115 116 117 118 119 120 121 122 123 124 125
   LOGICAL FUNCTION xcpot_vc_is_GGA(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_vc_is_GGA=.false.
   END FUNCTION xcpot_vc_is_GGA

   LOGICAL FUNCTION xcpot_vx_is_GGA(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_vx_is_GGA=.false.
   END FUNCTION xcpot_vx_is_GGA
   
126
   LOGICAL FUNCTION xcpot_vxc_is_gga(xcpot)
Matthias Redies's avatar
Matthias Redies committed
127 128
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
129
      xcpot_vxc_is_gga= xcpot%vx_is_GGA() .and. xcpot%vc_is_GGA()
130
   END FUNCTION xcpot_vxc_is_gga
Matthias Redies's avatar
Matthias Redies committed
131

132
   LOGICAL FUNCTION xcpot_exc_is_gga(xcpot)
Matthias Redies's avatar
Matthias Redies committed
133 134
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
135 136 137
      xcpot_exc_is_gga=.false.
   END FUNCTION xcpot_exc_is_gga

Matthias Redies's avatar
Matthias Redies committed
138 139 140 141 142 143
   LOGICAL FUNCTION xcpot_vx_is_MetaGGA(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_vx_is_MetaGGA=.false.
   END FUNCTION xcpot_vx_is_MetaGGA

144 145 146 147 148
   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
Daniel Wortmann's avatar
Daniel Wortmann committed
149

Matthias Redies's avatar
Matthias Redies committed
150 151 152
   LOGICAL FUNCTION xcpot_needs_grad(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
Matthias Redies's avatar
Matthias Redies committed
153

154
      xcpot_needs_grad= xcpot%vc_is_gga() .or. xcpot%vx_is_MetaGGA()
Matthias Redies's avatar
Matthias Redies committed
155
   END FUNCTION xcpot_needs_grad
156

Matthias Redies's avatar
Matthias Redies committed
157 158 159 160 161
   LOGICAL FUNCTION xcpot_is_hybrid(xcpot)
      IMPLICIT NONE
      CLASS(t_xcpot),INTENT(IN):: xcpot
      xcpot_is_hybrid=.FALSE.
   END FUNCTION xcpot_is_hybrid
162

Matthias Redies's avatar
Matthias Redies committed
163 164 165 166 167 168 169
   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
170

Matthias Redies's avatar
Matthias Redies committed
171
   SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh,vxc,vx,grad, kinED_KS)
Matthias Redies's avatar
Matthias Redies committed
172
      USE m_judft
Matthias Redies's avatar
Matthias Redies committed
173 174
      IMPLICIT NONE

Matthias Redies's avatar
Matthias Redies committed
175 176 177 178 179 180 181
      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
182
      REAL, INTENT(IN),OPTIONAL:: kinED_KS(:,:)
Matthias Redies's avatar
Matthias Redies committed
183 184 185 186

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

Matthias Redies's avatar
Matthias Redies committed
189
   SUBROUTINE xcpot_get_exc(xcpot,jspins,rh,exc,grad,kinED_KS, mt_call)
Matthias Redies's avatar
Matthias Redies committed
190
      USE m_types_misc
191
      USE m_judft
Matthias Redies's avatar
Matthias Redies committed
192
      USE, INTRINSIC :: IEEE_ARITHMETIC
Matthias Redies's avatar
Matthias Redies committed
193 194
      IMPLICIT NONE

Matthias Redies's avatar
Matthias Redies committed
195 196
      CLASS(t_xcpot),INTENT(IN)             :: xcpot
      INTEGER, INTENT (IN)                  :: jspins
Matthias Redies's avatar
Matthias Redies committed
197
      !--> charge density
Matthias Redies's avatar
Matthias Redies committed
198
      REAL,INTENT (IN)                      :: rh(:,:)
Matthias Redies's avatar
Matthias Redies committed
199
      !--> kinetic energy density
Matthias Redies's avatar
Matthias Redies committed
200
      !---> xc energy density
Matthias Redies's avatar
Matthias Redies committed
201 202
      REAL, INTENT (OUT)                    :: exc (:)
      TYPE(t_gradients),OPTIONAL,INTENT(IN) :: grad
203
      LOGICAL, OPTIONAL, INTENT(IN)         :: mt_call    
Matthias Redies's avatar
Matthias Redies committed
204
      REAL, INTENT(IN), OPTIONAL            :: kinED_KS(:,:)
Matthias Redies's avatar
Matthias Redies committed
205 206 207

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

Matthias Redies's avatar
Matthias Redies committed
210
   SUBROUTINE xcpot_alloc_gradients(ngrid,jspins,grad)
Matthias Redies's avatar
Matthias Redies committed
211 212
      IMPLICIT NONE

Matthias Redies's avatar
Matthias Redies committed
213 214
      INTEGER, INTENT (IN)         :: jspins,ngrid
      TYPE(t_gradients),INTENT(INOUT):: grad
215

Matthias Redies's avatar
Matthias Redies committed
216 217 218 219 220 221 222 223 224 225 226
      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
227
  END SUBROUTINE xcpot_alloc_gradients
228

Daniel Wortmann's avatar
Daniel Wortmann committed
229
END MODULE m_types_xcpot