metagga.F90 10.3 KB
Newer Older
Matthias Redies's avatar
Matthias Redies committed
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------

7
MODULE m_metagga
Matthias Redies's avatar
Matthias Redies committed
8

9 10 11
    TYPE t_realspace_potden
        REAL, ALLOCATABLE  :: is(:,:), mt(:,:)
    END TYPE t_realspace_potden
Matthias Redies's avatar
Matthias Redies committed
12

13 14
    PUBLIC  :: calc_EnergyDen
    PRIVATE :: calc_EnergyDen_auxillary_weights, t_realspace_potden, subtract_RS, multiply_RS
Matthias Redies's avatar
Matthias Redies committed
15

16 17 18
    INTERFACE OPERATOR (-)
        PROCEDURE subtract_RS
    END INTERFACE OPERATOR (-)
Matthias Redies's avatar
Matthias Redies committed
19

20 21 22 23 24 25
    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
26
#ifdef CPP_LIBXC 
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
        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_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
        TYPE(t_realspace_potden), INTENT(inout)        :: kinEnergyDen
Matthias Redies's avatar
Matthias Redies committed
60 61 62

        ! local vars

63 64
        TYPE(t_potden)                    :: EnergyDen
        TYPE(t_realspace_potden)          :: den_RS, EnergyDen_RS, vTot_RS
Matthias Redies's avatar
Matthias Redies committed
65 66


67 68
        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
69
        
70
        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
71 72 73

        kinEnergyDen = EnergyDen_RS - vTot_RS * den_RS
#else
74 75
        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
76
#endif
77
    END SUBROUTINE calc_kinEnergyDen
Matthias Redies's avatar
Matthias Redies committed
78

79 80
    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
81 82 83 84 85 86
        ! 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
         
        
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 113 114 115 116 117
        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
118 119 120


        ! local
121
        INTEGER                         :: jspin
Matthias Redies's avatar
Matthias Redies committed
122
 
123 124 125 126 127 128 129 130 131 132
        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
133 134
        tmp_results = results

135 136
        DO jspin = 1,input%jspins
            CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin)
Matthias Redies's avatar
Matthias Redies committed
137 138

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

141 142
            CALL cdnval(eig_id, mpi, kpts, jspin, noco, input, banddos, cell, atoms, &
                        enpara, stars, vacuum, DIMENSION, sphhar, sym, vTot, oneD, cdnvalJob, &
143
                        EnergyDen, regCharges, dos, tmp_results, moments)
144
        ENDDO
Matthias Redies's avatar
Matthias Redies committed
145

146
    END SUBROUTINE calc_EnergyDen
Matthias Redies's avatar
Matthias Redies committed
147

148 149 150 151
    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
152 153 154 155 156 157 158
        ! 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


159 160 161 162
        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
163 164

        ! local vars
165 166
        REAL                       :: w_i(SIZE(f_ik,dim=1)), e_i(SIZE(f_ik,dim=1))
        INTEGER                    :: ikpt
Matthias Redies's avatar
Matthias Redies committed
167

168 169
        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
170 171

            f_ik(:,ikpt) = e_i * w_i
172 173 174 175 176 177 178 179 180 181 182 183 184
        ENDDO
    END SUBROUTINE calc_EnergyDen_auxillary_weights

    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

        IMPLICIT NONE 
Matthias Redies's avatar
Matthias Redies committed
185
        
186 187 188 189 190 191 192 193 194
        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
        TYPE(t_realspace_potden), INTENT(out)       :: den_RS, EnergyDen_RS, vTot_RS ! could be changed to a real-space type
Matthias Redies's avatar
Matthias Redies committed
195 196

        !local vars
197 198 199 200
        TYPE(t_xcpot_libxc) ::aux_xcpot
        TYPE(t_gradients)   :: tmp_grad
        INTEGER, PARAMETER  :: id_corr = 9, id_exch = 1
        INTEGER             :: nsp, n
Matthias Redies's avatar
Matthias Redies committed
201 202 203 204



        !make some auxillary xcpot, that is not a GGA (we don't need gradients)
205
        CALL aux_xcpot%init(input%jspins, id_exch, id_corr, id_exch, id_corr)
206
        IF(aux_xcpot%vxc_is_gga()) CALL juDFT_error("aux_xcpot must not be GGA", &
Matthias Redies's avatar
Matthias Redies committed
207 208 209
                                                hint="choose id_corr and id_exch correctly")

        ! interstitial part
210
        CALL init_pw_grid(aux_xcpot,stars,sym,cell)
Matthias Redies's avatar
Matthias Redies committed
211

212 213 214
        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)
Matthias Redies's avatar
Matthias Redies committed
215

216
        CALL finish_pw_grid()
Matthias Redies's avatar
Matthias Redies committed
217 218 219

        ! muffin tins
        nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
220
        CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,aux_xcpot,sym)
Matthias Redies's avatar
Matthias Redies committed
221

222 223
        DO n = 1,atoms%ntype
            CALL mt_to_grid(aux_xcpot, input%jspins, atoms,    sphhar, den%mt(:,0:,n,:), &
224
                            nsp,       n,            tmp_grad, den_RS%mt)
225
            CALL mt_to_grid(aux_xcpot, input%jspins, atoms,    sphhar, EnergyDen%mt(:,0:,n,:), &
226
                            nsp,       n,            tmp_grad, EnergyDen_RS%mt)
227
            CALL mt_to_grid(aux_xcpot, input%jspins, atoms,    sphhar, vTot%mt(:,0:,n,:), &
228
                            nsp,       n,            tmp_grad, vTot_RS%mt)
229
        ENDDO
Matthias Redies's avatar
Matthias Redies committed
230

231 232
        CALL finish_mt_grid()
    END SUBROUTINE transform_to_grid
Matthias Redies's avatar
Matthias Redies committed
233

234 235
    FUNCTION subtract_RS(rs1, rs2) RESULT(rs_out)
        IMPLICIT NONE
Matthias Redies's avatar
Matthias Redies committed
236

237 238
        TYPE(t_realspace_potden), INTENT(in)  :: rs1, rs2
        TYPE(t_realspace_potden)              :: rs_out
Matthias Redies's avatar
Matthias Redies committed
239

240
        WRITE (*,*) "MT subtraction not implemented"
Matthias Redies's avatar
Matthias Redies committed
241 242

        rs_out%is = rs1%is - rs2%is 
243
    END FUNCTION subtract_RS 
Matthias Redies's avatar
Matthias Redies committed
244

245 246
    FUNCTION multiply_RS(rs1, rs2) RESULT(rs_out)
        IMPLICIT NONE
Matthias Redies's avatar
Matthias Redies committed
247
        
248 249
        TYPE(t_realspace_potden), INTENT(in)  :: rs1, rs2
        TYPE(t_realspace_potden)              :: rs_out
Matthias Redies's avatar
Matthias Redies committed
250

251
        WRITE (*,*) "MT multiplication not implemented"
Matthias Redies's avatar
Matthias Redies committed
252 253

        rs_out%is = rs1%is * rs2%is 
254
    END FUNCTION multiply_RS
Matthias Redies's avatar
Matthias Redies committed
255

256
END MODULE m_metagga