metagga.F90 10 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
Matthias Redies's avatar
Matthias Redies committed
8
    PRIVATE :: calc_EnergyDen_auxillary_weights, subtract_RS, multiply_RS
Matthias Redies's avatar
Matthias Redies committed
9

10 11 12
    INTERFACE OPERATOR (-)
        PROCEDURE subtract_RS
    END INTERFACE OPERATOR (-)
Matthias Redies's avatar
Matthias Redies committed
13

14 15 16 17 18 19
    INTERFACE OPERATOR (*)
        PROCEDURE multiply_RS
END INTERFACE OPERATOR (*)
CONTAINS
    SUBROUTINE calc_kinEnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, den, atoms, enpara, stars,&
                                 vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, kinEnergyDen)
Matthias Redies's avatar
Matthias Redies committed
20
#ifdef CPP_LIBXC 
21 22 23 24 25 26 27 28 29
        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
Matthias Redies's avatar
Matthias Redies committed
30
        USE m_types_xcpot
31 32 33 34 35
        USE m_cdnval


        IMPLICIT NONE

Matthias Redies's avatar
Matthias Redies committed
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
        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_potden),    INTENT(in)           :: den
        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
Matthias Redies's avatar
Matthias Redies committed
54
        REAL,              INTENT(inout)        :: kinEnergyDen(:,:)
Matthias Redies's avatar
Matthias Redies committed
55 56 57

        ! local vars

Matthias Redies's avatar
Matthias Redies committed
58 59
        TYPE(t_potden)          :: EnergyDen
        REAL                    :: den_RS(:,:), EnergyDen_RS(:,:), vTot_RS(:,:)
Matthias Redies's avatar
Matthias Redies committed
60 61


62 63
        CALL calc_EnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, atoms, enpara, stars, &
                            vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, EnergyDen)
Matthias Redies's avatar
Matthias Redies committed
64
        
Matthias Redies's avatar
Matthias Redies committed
65
        !CALL transform_to_grid(input, noco, sym, stars, cell, den, atoms, sphhar, EnergyDen, vTot, den_RS, EnergyDen_RS, vTot_RS)
Matthias Redies's avatar
Matthias Redies committed
66 67 68

        kinEnergyDen = EnergyDen_RS - vTot_RS * den_RS
#else
69 70
        USE m_juDFT_stop
        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
71
#endif
72
    END SUBROUTINE calc_kinEnergyDen
Matthias Redies's avatar
Matthias Redies committed
73

74 75
    SUBROUTINE calc_EnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, atoms, enpara, stars, &
                              vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, EnergyDen)
Matthias Redies's avatar
Matthias Redies committed
76 77 78 79 80 81
        ! 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
         
        
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
        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
Matthias Redies's avatar
Matthias Redies committed
113 114 115


        ! local
116
        INTEGER                         :: jspin
Matthias Redies's avatar
Matthias Redies committed
117
 
118 119 120 121 122 123 124 125 126 127
        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

        CALL regCharges%init(input, atoms)
        CALL dos%init(input,        atoms, DIMENSION, kpts, vacuum)
        CALL moments%init(input,    atoms)
Matthias Redies's avatar
Matthias Redies committed
128 129
        tmp_results = results

130 131
        DO jspin = 1,input%jspins
            CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin)
Matthias Redies's avatar
Matthias Redies committed
132 133

            ! replace brillouin weights with auxillary weights
134
            CALL calc_EnergyDen_auxillary_weights(eig_id, kpts, jspin, cdnvalJob%weights)
Matthias Redies's avatar
Matthias Redies committed
135

136 137
            CALL cdnval(eig_id, mpi, kpts, jspin, noco, input, banddos, cell, atoms, &
                        enpara, stars, vacuum, DIMENSION, sphhar, sym, vTot, oneD, cdnvalJob, &
138
                        EnergyDen, regCharges, dos, tmp_results, moments)
139
        ENDDO
Matthias Redies's avatar
Matthias Redies committed
140

141
    END SUBROUTINE calc_EnergyDen
Matthias Redies's avatar
Matthias Redies committed
142

143 144 145 146
    SUBROUTINE calc_EnergyDen_auxillary_weights(eig_id, kpts, jspin, f_ik)
        USE m_types_kpts
        USE m_eig66_io
        IMPLICIT NONE
Matthias Redies's avatar
Matthias Redies committed
147 148 149 150 151 152 153
        ! 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


154 155 156 157
        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)
Matthias Redies's avatar
Matthias Redies committed
158 159

        ! local vars
160 161
        REAL                       :: w_i(SIZE(f_ik,dim=1)), e_i(SIZE(f_ik,dim=1))
        INTEGER                    :: ikpt
Matthias Redies's avatar
Matthias Redies committed
162

163 164
        DO ikpt = 1,kpts%nkpt
            CALL read_eig(eig_id,ikpt,jspin, eig=e_i, w_iks=w_i)
Matthias Redies's avatar
Matthias Redies committed
165 166

            f_ik(:,ikpt) = e_i * w_i
167 168 169
        ENDDO
    END SUBROUTINE calc_EnergyDen_auxillary_weights

Matthias Redies's avatar
Matthias Redies committed
170 171 172 173 174 175 176 177
    !SUBROUTINE transform_to_grid(input, noco, sym, stars, cell, den, atoms, sphhar, EnergyDen, vTot, den_RS, EnergyDen_RS, vTot_RS)
        !USE m_types_potden
        !USE m_types_setup
        !USE m_types_xcpot_libxc
        !USE m_types_xcpot
        !USE m_juDFT_stop
        !USE m_pw_tofrom_grid
        !USE m_mt_tofrom_grid
178

Matthias Redies's avatar
Matthias Redies committed
179
        !IMPLICIT NONE 
Matthias Redies's avatar
Matthias Redies committed
180
        
Matthias Redies's avatar
Matthias Redies committed
181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227
        !TYPE(t_potden),    INTENT(in)        :: den, EnergyDen, vTot 
        !TYPE(t_input),     INTENT(in)        :: input
        !TYPE(t_noco),      INTENT(in)        :: noco
        !TYPE(t_sym),       INTENT(in)        :: sym
        !TYPE(t_stars),     INTENT(in)        :: stars
        !TYPE(t_cell),      INTENT(in)        :: cell
        !TYPE(t_atoms),     INTENT(in)        :: atoms
        !TYPE(t_sphhar),    INTENT(in)        :: sphhar
        !REAL(:,:), INTENT(out)               :: den_RS, EnergyDen_RS, vTot_RS ! could be changed to a real-space type

        !!local vars
        !TYPE(t_xcpot_libxc) ::aux_xcpot
        !TYPE(t_gradients)   :: tmp_grad
        !INTEGER, PARAMETER  :: id_corr = 9, id_exch = 1
        !INTEGER             :: nsp, n



        !!make some auxillary xcpot, that is not a GGA (we don't need gradients)
        !CALL aux_xcpot%init(input%jspins, id_exch, id_corr, id_exch, id_corr)
        !IF(aux_xcpot%vxc_is_gga()) CALL juDFT_error("aux_xcpot must not be GGA", &
                                                !hint="choose id_corr and id_exch correctly")

        !! interstitial part
        !CALL init_pw_grid(aux_xcpot,stars,sym,cell)

        !CALL pw_to_grid(aux_xcpot, input%jspins, noco%l_noco, stars, cell, den%pw,       tmp_grad, den_RS%is)
        !CALL pw_to_grid(aux_xcpot, input%jspins, noco%l_noco, stars, cell, EnergyDen%pw, tmp_grad, EnergyDen_RS%is)
        !CALL pw_to_grid(aux_xcpot, input%jspins, noco%l_noco, stars, cell, vTot%pw,      tmp_grad, vTot_RS%is)

        !CALL finish_pw_grid()

        !! muffin tins
        !nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
        !CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,aux_xcpot,sym)

        !DO n = 1,atoms%ntype
            !CALL mt_to_grid(aux_xcpot, input%jspins, atoms,    sphhar, den%mt(:,0:,n,:), &
                            !nsp,       n,            tmp_grad, den_RS%mt)
            !CALL mt_to_grid(aux_xcpot, input%jspins, atoms,    sphhar, EnergyDen%mt(:,0:,n,:), &
                            !nsp,       n,            tmp_grad, EnergyDen_RS%mt)
            !CALL mt_to_grid(aux_xcpot, input%jspins, atoms,    sphhar, vTot%mt(:,0:,n,:), &
                            !nsp,       n,            tmp_grad, vTot_RS%mt)
        !ENDDO

        !CALL finish_mt_grid()
    !END SUBROUTINE transform_to_grid
Matthias Redies's avatar
Matthias Redies committed
228

229
    FUNCTION subtract_RS(rs1, rs2) RESULT(rs_out)
Matthias Redies's avatar
Matthias Redies committed
230
       USE m_types_xcpot
231
        IMPLICIT NONE
Matthias Redies's avatar
Matthias Redies committed
232

Matthias Redies's avatar
Matthias Redies committed
233 234
        TYPE(t_RS_potden), INTENT(in)  :: rs1, rs2
        TYPE(t_RS_potden)              :: rs_out
Matthias Redies's avatar
Matthias Redies committed
235 236

        rs_out%is = rs1%is - rs2%is 
Matthias Redies's avatar
Matthias Redies committed
237
        rs_out%mt = rs1%mt - rs2%mt
238
    END FUNCTION subtract_RS 
Matthias Redies's avatar
Matthias Redies committed
239

240
    FUNCTION multiply_RS(rs1, rs2) RESULT(rs_out)
Matthias Redies's avatar
Matthias Redies committed
241
       USE m_types_xcpot
242
        IMPLICIT NONE
Matthias Redies's avatar
Matthias Redies committed
243
        
Matthias Redies's avatar
Matthias Redies committed
244 245
        TYPE(t_RS_potden), INTENT(in)  :: rs1, rs2
        TYPE(t_RS_potden)              :: rs_out
Matthias Redies's avatar
Matthias Redies committed
246

Matthias Redies's avatar
Matthias Redies committed
247 248
        rs_out%is = rs1%is * rs2%is
        rs_out%mt = rs1%mt * rs2%mt
249
    END FUNCTION multiply_RS
Matthias Redies's avatar
Matthias Redies committed
250

251
END MODULE m_metagga