Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 : MODULE m_types_xcpot_inbuild_nofunction
7 : !This module contains the xcpot-type used for the in-build xc-implementations
8 : USE m_types_xcpot_data
9 : USE m_types_xcpot
10 : USE m_judft
11 : IMPLICIT NONE
12 : PRIVATE
13 : REAL, PARAMETER, PRIVATE :: hrtr_half = 0.5
14 : CHARACTER(len=4), PARAMETER:: xc_names(20) = [ &
15 : 'l91 ', 'x-a ', 'wign', 'mjw ', 'hl ', 'bh ', 'vwn ', 'pz ', &
16 : 'pw91', 'pbe ', 'rpbe', 'Rpbe', 'wc ', 'PBEs', &
17 : 'pbe0', 'hse ', 'vhse', 'lhse', 'exx ', 'hf ']
18 :
19 : LOGICAL, PARAMETER:: priv_LDA(20) = [ &
20 : .FALSE., .TRUE., .TRUE., .TRUE., .TRUE., .TRUE., .TRUE., .TRUE., &
21 : .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
22 : .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE.]
23 :
24 : LOGICAL, PARAMETER:: priv_gga(20) = [ &
25 : .TRUE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
26 : .TRUE., .TRUE., .TRUE., .TRUE., .TRUE., .TRUE., &
27 : .TRUE., .TRUE., .TRUE., .TRUE., .FALSE., .TRUE.]
28 :
29 : LOGICAL, PARAMETER:: priv_hybrid(20) = [ &
30 : .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
31 : .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
32 : .TRUE., .TRUE., .TRUE., .TRUE., .TRUE., .TRUE.]
33 :
34 : REAL, PARAMETER :: amix_pbe0 = 0.25
35 : REAL, PARAMETER :: amix_hse = 0.25
36 : REAL, PARAMETER :: amix_hf = 1.00
37 :
38 : TYPE, EXTENDS(t_xcpot):: t_xcpot_inbuild_nf
39 : INTEGER :: icorr = 0
40 : TYPE(t_xcpot_data) :: data
41 :
42 : CONTAINS
43 : !overloading t_xcpot:
44 : PROCEDURE :: vx_is_LDA => xcpot_vx_is_LDA
45 : PROCEDURE :: vx_is_GGA => xcpot_vx_is_GGA
46 :
47 : PROCEDURE :: vc_is_LDA => xcpot_vc_is_LDA
48 : PROCEDURE :: vc_is_GGA => xcpot_vc_is_GGA
49 :
50 : PROCEDURE :: exc_is_LDA => xcpot_exc_is_LDA
51 : PROCEDURE :: exc_is_gga => xcpot_exc_is_gga
52 : PROCEDURE :: is_hybrid => xcpot_is_hybrid
53 :
54 : PROCEDURE :: get_exchange_weight => xcpot_get_exchange_weight
55 : PROCEDURE :: get_vxc => xcpot_get_vxc
56 : PROCEDURE :: get_exc => xcpot_get_exc
57 : !not overloaded
58 : PROCEDURE :: get_name => xcpot_get_name
59 : PROCEDURE :: relativistic_correction
60 : PROCEDURE :: is_name => xcpot_is_name
61 : PROCEDURE :: init => xcpot_init
62 : END TYPE t_xcpot_inbuild_nf
63 : PUBLIC t_xcpot_inbuild_nf
64 : CONTAINS
65 :
66 : Subroutine Mpi_bc_xcpot_ib(This, Mpi_comm, Irank)
67 : Use M_mpi_bc_tool
68 : Class(t_xcpot_inbuild_nf), Intent(Inout)::This
69 : Integer, Intent(In):: Mpi_comm
70 : Integer, Intent(In), Optional::Irank
71 : Integer ::Rank
72 : If (Present(Irank)) Then
73 : Rank = Irank
74 : Else
75 : Rank = 0
76 : End If
77 :
78 : ! Bcasts for abstract base class t_xcpot
79 : CALL mpi_bc(this%l_libxc, rank, mpi_comm)
80 : CALL mpi_bc(this%func_vxc_id_c, rank, mpi_comm)
81 : CALL mpi_bc(this%func_vxc_id_x, rank, mpi_comm)
82 : CALL mpi_bc(this%func_exc_id_c, rank, mpi_comm)
83 : CALL mpi_bc(this%func_exc_id_x, rank, mpi_comm)
84 : CALL mpi_bc(this%l_inbuild, rank, mpi_comm)
85 : CALL mpi_bc(rank, mpi_comm, this%inbuild_name)
86 : CALL mpi_bc(this%l_relativistic, rank, mpi_comm)
87 :
88 : ! Bcasts for derived class t_xcpot_inbuild
89 : CALL mpi_bc(this%icorr, rank, mpi_comm)
90 : call this%data%mpi_bc(rank, mpi_comm)
91 :
92 : END SUBROUTINE mpi_bc_xcpot_ib
93 :
94 0 : LOGICAL FUNCTION relativistic_correction(xcpot)
95 : IMPLICIT NONE
96 : CLASS(t_xcpot_inbuild_nf), INTENT(IN) :: xcpot
97 0 : relativistic_correction = xcpot%DATA%krla == 1
98 0 : END FUNCTION relativistic_correction
99 :
100 0 : CHARACTER(len=4) FUNCTION xcpot_get_name(xcpot)
101 : USE m_judft
102 : IMPLICIT NONE
103 : CLASS(t_xcpot_inbuild_nf), INTENT(IN) :: xcpot
104 0 : IF (xcpot%icorr == 0) CALL judft_error("xc-potential not initialized", calledby="types_xcpot.F90")
105 0 : xcpot_get_name = xc_names(xcpot%icorr)
106 0 : END FUNCTION xcpot_get_name
107 :
108 154 : SUBROUTINE xcpot_init(xcpot, ntype)
109 : USE m_judft
110 : IMPLICIT NONE
111 : CLASS(t_xcpot_inbuild_nf), INTENT(INOUT) :: xcpot
112 : INTEGER, INTENT(IN) :: ntype
113 : INTEGER:: n
114 : !Determine icorr from name
115 :
116 154 : IF (.NOT. xcpot%l_inbuild) CALL judft_error("Could not initialize inbuild xcpot")
117 :
118 154 : xcpot%icorr = 0
119 3234 : DO n = 1, SIZE(xc_names)
120 3234 : IF (TRIM(ADJUSTL(xcpot%inbuild_name)) == TRIM(xc_names(n))) THEN
121 154 : xcpot%icorr = n
122 : ENDIF
123 : ENDDO
124 154 : if (xcpot%icorr == 0) CALL judft_error("Unknown xc-potential:"//xcpot%inbuild_name, calledby="types_xcpot.F90")
125 154 : IF (xcpot%l_relativistic) THEN
126 0 : xcpot%DATA%krla = 1
127 : ELSE
128 154 : xcpot%DATA%krla = 0
129 : END IF
130 :
131 : !Code from exchpbe to speed up determination of constants
132 154 : IF (xcpot%is_name("rpbe")) THEN
133 0 : xcpot%data%uk = 1.2450
134 : ELSE
135 154 : xcpot%data%uk = 0.8040
136 : ENDIF
137 154 : IF (xcpot%is_name("PBEs")) THEN ! pbe_sol
138 0 : xcpot%data%um = 0.123456790123456d0
139 : ELSE
140 154 : xcpot%data%um = 0.2195149727645171e0
141 : ENDIF
142 154 : xcpot%data%is_hse = xcpot%is_name("hse") .OR. xcpot%is_name("lhse") .OR. xcpot%is_name("vhse")
143 154 : xcpot%data%is_rpbe = xcpot%is_name("Rpbe") !Rpbe
144 154 : xcpot%data%is_wc = xcpot%is_name("wc")
145 154 : xcpot%data%is_pbes = xcpot%is_name("PBEs")
146 154 : xcpot%data%is_pbe0 = xcpot%is_name("pbe0")
147 154 : xcpot%data%is_mjw = xcpot%is_name("mjw")
148 154 : xcpot%data%is_bh = xcpot%is_name("bh")
149 154 : xcpot%DATA%exchange_weight = xcpot%get_exchange_weight()
150 :
151 154 : END SUBROUTINE xcpot_init
152 :
153 : !! LDA
154 0 : logical function xcpot_exc_is_lda(xcpot)
155 : implicit none
156 : CLASS(t_xcpot_inbuild_nf), INTENT(IN):: xcpot
157 0 : xcpot_exc_is_lda = xcpot%vxc_is_lda()
158 0 : end function xcpot_exc_is_lda
159 :
160 0 : logical function xcpot_vx_is_lda(xcpot)
161 : implicit none
162 : CLASS(t_xcpot_inbuild_nf), INTENT(IN):: xcpot
163 0 : xcpot_vx_is_lda = (.not. xcpot%vxc_is_gga()) .and. (.not. xcpot%is_hybrid())
164 0 : end function xcpot_vx_is_lda
165 :
166 0 : logical function xcpot_vc_is_lda(xcpot)
167 : implicit none
168 : CLASS(t_xcpot_inbuild_nf), INTENT(IN):: xcpot
169 0 : xcpot_vc_is_lda = (.not. xcpot%vxc_is_gga()) .and. (.not. xcpot%is_hybrid())
170 0 : end function xcpot_vc_is_lda
171 :
172 984 : logical function xcpot_vx_is_gga(xcpot)
173 : implicit none
174 : CLASS(t_xcpot_inbuild_nf), INTENT(IN):: xcpot
175 984 : xcpot_vx_is_gga = priv_gga(xcpot%icorr)
176 984 : end function xcpot_vx_is_gga
177 :
178 8297 : logical function xcpot_vc_is_gga(xcpot)
179 : implicit none
180 : CLASS(t_xcpot_inbuild_nf), INTENT(IN):: xcpot
181 8297 : xcpot_vc_is_gga = priv_gga(xcpot%icorr)
182 8297 : end function xcpot_vc_is_gga
183 :
184 984 : LOGICAL FUNCTION xcpot_exc_is_gga(xcpot)
185 : IMPLICIT NONE
186 : CLASS(t_xcpot_inbuild_nf), INTENT(IN):: xcpot
187 984 : xcpot_exc_is_gga = xcpot%vxc_is_gga()
188 984 : END FUNCTION xcpot_exc_is_gga
189 :
190 1161 : LOGICAL FUNCTION xcpot_is_hybrid(xcpot)
191 : IMPLICIT NONE
192 : CLASS(t_xcpot_inbuild_nf), INTENT(IN):: xcpot
193 1161 : xcpot_is_hybrid = priv_hybrid(xcpot%icorr)
194 1161 : END FUNCTION xcpot_is_hybrid
195 :
196 8209 : FUNCTION xcpot_get_exchange_weight(xcpot) RESULT(a_ex)
197 : USE m_judft
198 : IMPLICIT NONE
199 : CLASS(t_xcpot_inbuild_nf), INTENT(IN):: xcpot
200 :
201 : REAL:: a_ex
202 :
203 8209 : a_ex = -1
204 8209 : IF (xcpot%is_name("pbe0")) a_ex = amix_pbe0
205 8209 : IF (xcpot%is_name("hf")) a_ex = amix_hf
206 8209 : IF (xcpot%is_name("hse")) a_ex = amix_hse
207 8209 : IF (xcpot%is_name("vhse")) a_ex = amix_hse
208 8209 : END FUNCTION xcpot_get_exchange_weight
209 :
210 0 : SUBROUTINE xcpot_get_vxc(xcpot, jspins, rh, vxc, vx, grad, kinEnergyDen_KS)
211 : !
212 : IMPLICIT NONE
213 : !c
214 : !c---> running mode parameters
215 : !c
216 : CLASS(t_xcpot_inbuild_nf), INTENT(IN) :: xcpot
217 : INTEGER, INTENT(IN) :: jspins
218 : !c
219 : !c---> charge density
220 : !c
221 : REAL, INTENT(IN) :: rh(:, :)
222 : !c
223 : !c---> xc potential
224 : !c
225 : REAL, INTENT(OUT) :: vx(:, :)
226 : REAL, INTENT(OUT) :: vxc(:, :)
227 :
228 : ! optional arguments for GGA
229 : TYPE(t_gradients), INTENT(INOUT), OPTIONAL::grad
230 : REAL, INTENT(IN), OPTIONAL :: kinEnergyDen_KS(:, :)
231 0 : CALL judft_error("BUG: dummy xcxpot type is not functional and should not be called")
232 :
233 0 : END SUBROUTINE xcpot_get_vxc
234 :
235 : !***********************************************************************
236 0 : SUBROUTINE xcpot_get_exc(xcpot, jspins, rh, exc, grad, kinEnergyDen_KS, mt_call)
237 : !***********************************************************************
238 : IMPLICIT NONE
239 :
240 : CLASS(t_xcpot_inbuild_nf), INTENT(IN) :: xcpot
241 : INTEGER, INTENT(IN) :: jspins
242 : REAL, INTENT(IN) :: rh(:, :)
243 : REAL, INTENT(OUT) :: exc(:)
244 : TYPE(t_gradients), OPTIONAL, INTENT(IN) ::grad
245 : LOGICAL, OPTIONAL, INTENT(IN) :: mt_call
246 : REAL, INTENT(IN), OPTIONAL :: kinEnergyDen_KS(:, :)
247 :
248 : !c
249 : !c ---> local scalars
250 0 : CALL judft_error("BUG: dummy xcxpot type is not functional and should not be called")
251 :
252 0 : END SUBROUTINE xcpot_get_exc
253 :
254 46439 : LOGICAL FUNCTION xcpot_is_name(xcpot, name)
255 : CLASS(t_xcpot_inbuild_nf), INTENT(IN):: xcpot
256 : CHARACTER(len=*), INTENT(IN) :: name
257 46439 : xcpot_is_name = (TRIM(xc_names(xcpot%icorr)) == TRIM((name)))
258 46439 : END FUNCTION xcpot_is_name
259 :
260 0 : END MODULE m_types_xcpot_inbuild_nofunction
|
