metagga.F90 6.66 KB
Newer Older
Matthias Redies's avatar
Matthias Redies committed
1 2 3 4 5
!--------------------------------------------------------------------------------
! Copyright (c) 2018 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.
!--------------------------------------------------------------------------------
6
MODULE m_metagga
Matthias Redies's avatar
Matthias Redies committed
7
   PUBLIC  :: calc_EnergyDen
8
   PRIVATE :: calc_EnergyDen_auxillary_weights
Matthias Redies's avatar
Matthias Redies committed
9

Matthias Redies's avatar
Matthias Redies committed
10 11 12
   type t_RS_potden
      REAL, ALLOCATABLE :: is(:,:), mt(:,:)
   end type t_RS_potden
Matthias Redies's avatar
Matthias Redies committed
13

14
CONTAINS
15
   SUBROUTINE calc_kinEnergyDen_pw(EnergyDen_rs, vTot_rs, den_rs, kinEnergyDen_RS)
16
      USE m_juDFT_stop
Matthias Redies's avatar
Matthias Redies committed
17
      !use m_cdngen
Matthias Redies's avatar
Matthias Redies committed
18 19 20
      IMPLICIT NONE
      REAL, INTENT(in)                 :: den_RS(:,:), EnergyDen_RS(:,:), vTot_RS(:,:)
      REAL, INTENT(inout), allocatable :: kinEnergyDen_RS(:,:)
21
#ifdef CPP_LIBXC
Matthias Redies's avatar
Matthias Redies committed
22
      REAL, PARAMETER                  :: eps = 1e-15
Matthias Redies's avatar
Matthias Redies committed
23 24

      kinEnergyDen_RS = EnergyDen_RS - vTot_RS * den_RS
25 26 27 28 29 30 31 32 33 34 35 36
#else
      CALL juDFT_error("MetaGGA require LibXC",hint="compile Fleur with LibXC (e.g. by giving '-external libxc' to ./configure")
#endif
   END SUBROUTINE calc_kinEnergyDen_pw

   SUBROUTINE calc_kinEnergyDen_mt(EnergyDen_RS, vTot_rs, vTot0_rs, core_den_rs, val_den_rs, &
                                   atm_idx, nsp, kinEnergyDen_RS)
      USE m_juDFT_stop
      USE m_juDFT_string
      implicit none
      REAL, INTENT(in)                 :: EnergyDen_RS(:,:), vTot_rs(:,:), vTot0_rs(:,:), core_den_rs(:,:), val_den_rs(:,:)
      INTEGER, intent(in)              :: atm_idx, nsp
Matthias Redies's avatar
Matthias Redies committed
37
      REAL, INTENT(inout)              :: kinEnergyDen_RS(:,:)
38 39 40

#ifdef CPP_LIBXC
      kinEnergyDen_RS = EnergyDen_RS - (vTot0_rs * core_den_rs + vTot_rs * val_den_rs)
Matthias Redies's avatar
Matthias Redies committed
41
#else
Matthias Redies's avatar
Matthias Redies committed
42
      CALL juDFT_error("MetaGGA require LibXC",hint="compile Fleur with LibXC (e.g. by giving '-external libxc' to ./configure")
Matthias Redies's avatar
Matthias Redies committed
43
#endif
44
   END SUBROUTINE calc_kinEnergyDen_mt
Matthias Redies's avatar
Matthias Redies committed
45

Matthias Redies's avatar
Matthias Redies committed
46

Matthias Redies's avatar
Matthias Redies committed
47
   SUBROUTINE calc_EnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, atoms, enpara, stars, &
48
         vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, EnergyDen)
Matthias Redies's avatar
Matthias Redies committed
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 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 92 93 94
      ! calculates the energy density
      ! EnergyDen = \sum_i n_i(r) \varepsilon_i
      ! where n_i(r) is the one-particle density
      ! and \varepsilon_i are the eigenenergies

      USE m_types_setup
      USE m_types_potden
      USE m_types_kpts
      USE m_types_mpi
      USE m_types_enpara
      USE m_types_misc
      USE m_types_regionCharges
      USE m_types_dos
      USE m_types_cdnval
      USE m_cdnval

      IMPLICIT NONE

      INTEGER,           INTENT(in)           :: eig_id
      TYPE(t_mpi),       INTENT(in)           :: mpi
      TYPE(t_kpts),      INTENT(in)           :: kpts
      TYPE(t_noco),      INTENT(in)           :: noco
      TYPE(t_input),     INTENT(in)           :: input
      TYPE(t_banddos),   INTENT(in)           :: banddos
      TYPE(t_cell),      INTENT(in)           :: cell
      TYPE(t_atoms),     INTENT(in)           :: atoms
      TYPE(t_enpara),    INTENT(in)           :: enpara
      TYPE(t_stars),     INTENT(in)           :: stars
      TYPE(t_vacuum),    INTENT(in)           :: vacuum
      TYPE(t_dimension), INTENT(in)           :: DIMENSION
      TYPE(t_sphhar),    INTENT(in)           :: sphhar
      TYPE(t_sym),       INTENT(in)           :: sym
      TYPE(t_potden),    INTENT(in)           :: vTot
      TYPE(t_oneD),      INTENT(in)           :: oneD
      TYPE(t_results),   INTENT(in)           :: results
      TYPE(t_potden),    INTENT(inout)        :: EnergyDen

      ! local
      INTEGER                         :: jspin

      TYPE(t_regionCharges)           :: regCharges
      TYPE(t_dos)                     :: dos
      TYPE(t_moments)                 :: moments
      TYPE(t_results)                 :: tmp_results
      TYPE(t_cdnvalJob)               :: cdnvalJob
      TYPE(t_potden)                  :: aux_den, real_den
95

Matthias Redies's avatar
Matthias Redies committed
96 97 98 99 100 101 102 103

      CALL regCharges%init(input, atoms)
      CALL dos%init(input,        atoms, DIMENSION, kpts, vacuum)
      CALL moments%init(input,    atoms)
      tmp_results = results

      DO jspin = 1,input%jspins
         CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin)
104

Matthias Redies's avatar
Matthias Redies committed
105 106 107 108 109

         ! replace brillouin weights with auxillary weights
         CALL calc_EnergyDen_auxillary_weights(eig_id, kpts, jspin, cdnvalJob%weights)

         CALL cdnval(eig_id, mpi, kpts, jspin, noco, input, banddos, cell, atoms, &
110 111
            enpara, stars, vacuum, DIMENSION, sphhar, sym, vTot, oneD, cdnvalJob, &
            EnergyDen, regCharges, dos, tmp_results, moments)
Matthias Redies's avatar
Matthias Redies committed
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
      ENDDO

   END SUBROUTINE calc_EnergyDen

   SUBROUTINE calc_EnergyDen_auxillary_weights(eig_id, kpts, jspin, f_ik)
      USE m_types_kpts
      USE m_eig66_io
      IMPLICIT NONE
      ! calculates new (auxillary-)weights as
      ! f_iks = w_iks * E_iks
      !, where  f_iks are the new (auxillary-)weights
      ! w_iks are the weights used in brillouin zone integration
      ! E_iks are the eigen energies

      INTEGER,      INTENT(in)        :: eig_id
      INTEGER,      INTENT(in)        :: jspin
      TYPE(t_kpts), INTENT(in)        :: kpts
      REAL,         INTENT(inout)     :: f_ik(:,:) ! f_ik(band_idx, kpt_idx)

      ! local vars
132
      REAL                       :: e_i(SIZE(f_ik,dim=1))
Matthias Redies's avatar
Matthias Redies committed
133 134 135
      INTEGER                    :: ikpt

      DO ikpt = 1,kpts%nkpt
136 137
         CALL read_eig(eig_id,ikpt,jspin, eig=e_i)
         f_ik(:,ikpt) = f_ik(:,ikpt) * e_i
Matthias Redies's avatar
Matthias Redies committed
138 139
      ENDDO
   END SUBROUTINE calc_EnergyDen_auxillary_weights
Matthias Redies's avatar
Matthias Redies committed
140

Matthias Redies's avatar
Matthias Redies committed
141
   subroutine set_zPrime(dim_idx, zMat, kpt, lapw, cell, zPrime)
Matthias Redies's avatar
Matthias Redies committed
142
      USE m_types
Matthias Redies's avatar
Matthias Redies committed
143
      USE m_constants
Matthias Redies's avatar
Matthias Redies committed
144
      implicit none
Matthias Redies's avatar
Matthias Redies committed
145
      INTEGER, intent(in)      :: dim_idx
Matthias Redies's avatar
Matthias Redies committed
146 147 148
      TYPE (t_mat), intent(in) :: zMat
      REAL, intent(in)         :: kpt(3) 
      TYPE(t_lapw), intent(in) :: lapw
Matthias Redies's avatar
Matthias Redies committed
149
      TYPE(t_cell), intent(in) :: cell
Matthias Redies's avatar
Matthias Redies committed
150 151
      TYPE (t_mat)             :: zPrime

Matthias Redies's avatar
Matthias Redies committed
152
      REAL                     :: k_plus_g(3), fac
Matthias Redies's avatar
Matthias Redies committed
153
      INTEGER                  :: basis_idx
Matthias Redies's avatar
Matthias Redies committed
154

Matthias Redies's avatar
Matthias Redies committed
155 156
      call zPrime%free()
      call zPrime%init(zMat)
Matthias Redies's avatar
Matthias Redies committed
157

Matthias Redies's avatar
Matthias Redies committed
158
      do basis_idx = 1,size(lapw%gvec,dim=2)
Matthias Redies's avatar
Matthias Redies committed
159 160 161 162
         k_plus_g = kpt + lapw%gvec(:,basis_idx,1)
         k_plus_g = internal_to_rez(cell, k_plus_g)

         fac = k_plus_g(dim_idx)
Matthias Redies's avatar
Matthias Redies committed
163
         if(zPrime%l_real) then
Matthias Redies's avatar
Matthias Redies committed
164
            zPrime%data_r(basis_idx,:) =            fac * zMat%data_r(basis_idx,:) 
Matthias Redies's avatar
Matthias Redies committed
165
         else
Matthias Redies's avatar
Matthias Redies committed
166
            zPrime%data_c(basis_idx,:) = ImagUnit * fac * zMat%data_c(basis_idx,:) 
Matthias Redies's avatar
Matthias Redies committed
167
         endif
Matthias Redies's avatar
Matthias Redies committed
168
      enddo
Matthias Redies's avatar
Matthias Redies committed
169
   end subroutine set_zPrime
Matthias Redies's avatar
Matthias Redies committed
170 171 172 173 174 175 176 177 178 179

   function internal_to_rez(cell, vec) result(res)
      use m_types
      implicit none
      type(t_cell), intent(in) :: cell
      real, intent(in)      :: vec(3)
      real                  :: res(3)

      res = matmul(transpose(cell%bmat), vec)
   end function internal_to_rez
180

Matthias Redies's avatar
Matthias Redies committed
181
END MODULE m_metagga