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
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_types_xcpot_inbuild_nofunction
11 : USE m_judft
12 : IMPLICIT NONE
13 : PRIVATE
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 : TYPE, EXTENDS(t_xcpot_inbuild_nf):: t_xcpot_inbuild
20 : CONTAINS
21 : !overloading t_xcpot:
22 : PROCEDURE :: get_vxc => xcpot_get_vxc
23 : PROCEDURE :: get_exc => xcpot_get_exc
24 : END TYPE t_xcpot_inbuild
25 : PUBLIC t_xcpot_inbuild
26 : CONTAINS
27 :
28 :
29 2914 : SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh, vxc,vx, grad,kinEnergyDen_KS)
30 : !
31 : USE m_xcxal, ONLY : vxcxal
32 : USE m_xcwgn, ONLY : vxcwgn
33 : USE m_xcbh, ONLY : vxcbh
34 : USE m_xcvwn, ONLY : vxcvwn
35 : USE m_xcpz, ONLY : vxcpz
36 : USE m_vxcl91
37 : USE m_vxcwb91
38 : USE m_vxcpw91
39 : USE m_vxcepbe
40 : IMPLICIT NONE
41 : !c
42 : !c---> running mode parameters
43 : !c
44 : CLASS(t_xcpot_inbuild),INTENT(IN) :: xcpot
45 : INTEGER, INTENT (IN) :: jspins
46 : !c
47 : !c---> charge density
48 : !c
49 : REAL,INTENT (IN) :: rh(:,:)
50 : !c
51 : !c---> xc potential
52 : !c
53 : REAL, INTENT (OUT) :: vx (:,:)
54 : REAL, INTENT (OUT) :: vxc(:,:)
55 :
56 : ! optional arguments for GGA
57 : TYPE(t_gradients),INTENT(INOUT),OPTIONAL::grad
58 : REAL, INTENT(IN), OPTIONAL :: kinEnergyDen_KS(:,:)
59 : !c
60 : !c ---> local scalars
61 : INTEGER :: ngrid
62 : REAL, PARAMETER :: hrtr_half = 0.5
63 :
64 : !used to be dummy arguments for testing
65 : INTEGER,PARAMETER :: idsprs=0,isprsv=0,iofile=6
66 : REAL,PARAMETER :: sprsv=0.0
67 : LOGICAL,PARAMETER :: lwbc=.false. ! l-white-bird-current (ta)
68 : !c
69 : !c.....------------------------------------------------------------------
70 : !c
71 : !c-----> determine exchange correlation potential
72 : !c
73 151278704 : vx (:,:) = 0.0
74 151278704 : vxc(:,:) = 0.0
75 2914 : ngrid=SIZE(rh,1)
76 :
77 2914 : IF (xcpot%needs_grad()) THEN
78 1932 : IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
79 1932 : IF (xcpot%is_name("l91")) THEN ! local pw91
80 : CALL vxcl91(jspins,ngrid,ngrid,rh,grad%agrt(:ngrid),grad%agru(:ngrid),grad%agrd(:ngrid), grad%g2rt(:ngrid),&
81 : grad%g2ru(:ngrid),grad%g2rd(:ngrid),grad%gggrt(:ngrid),grad%gggru(:ngrid),grad%gggrd(:ngrid),&
82 0 : grad%gzgr(:ngrid), vx(:ngrid,:),vxc(:ngrid,:), isprsv,sprsv)
83 1932 : ELSEIF (xcpot%is_name("pw91")) THEN ! pw91
84 : IF (lwbc) THEN
85 : CALL vxcwb91(jspins,ngrid,ngrid,rh(:ngrid,:),grad%agrt(:ngrid),grad%agru(:ngrid),grad%agrd(:ngrid),&
86 : grad%g2rt(:ngrid),grad%g2ru(:ngrid),grad%g2rd(:ngrid),grad%gggrt(:ngrid),grad%gggru(:ngrid),&
87 : grad%gggrd(:ngrid),grad%gzgr(:ngrid), vx(:ngrid,:),vxc(:ngrid,:), idsprs,isprsv,sprsv)
88 : ELSE
89 :
90 : CALL vxcpw91(jspins,ngrid,ngrid,rh(:ngrid,:),grad%agrt(:ngrid),grad%agru(:ngrid),grad%agrd(:ngrid),&
91 : grad%g2rt(:ngrid),grad%g2ru(:ngrid),grad%g2rd(:ngrid),grad%gggrt(:ngrid),grad%gggru(:ngrid),&
92 0 : grad%gggrd,grad%gzgr, vx(:ngrid,:),vxc(:ngrid,:), idsprs,isprsv,sprsv)
93 :
94 : ENDIF
95 : ELSE ! pbe or similar
96 4544307 : CALL vxcepbe(xcpot%DATA,jspins,ngrid,ngrid,rh(:ngrid,:), grad%agrt,grad%agru,grad%agrd,grad%g2ru,grad%g2rd,grad%gggrt,grad%gggru,grad%gggrd, vx(:ngrid,:),vxc(:ngrid,:))
97 : ENDIF
98 : ELSE !LDA potentials
99 982 : IF (xcpot%is_name("x-a")) THEN ! X-alpha method
100 0 : CALL vxcxal(xcpot%data%krla,jspins, ngrid,ngrid,rh(:ngrid,:), vx(:ngrid,:),vxc(:ngrid,:))
101 982 : ELSEIF (xcpot%is_name("wign")) THEN ! Wigner interpolation formula
102 0 : CALL vxcwgn(xcpot%data%krla,jspins, ngrid,ngrid,rh(:ngrid,:), vx(:ngrid,:),vxc(:ngrid,:))
103 982 : ELSEIF (xcpot%is_name("mjw").OR.xcpot%is_name("bh")) THEN ! von Barth,Hedin correlation
104 0 : CALL vxcbh(iofile,xcpot%data,jspins, ngrid,ngrid,rh(:ngrid,:), vx(:ngrid,:),vxc(:ngrid,:))
105 :
106 982 : ELSEIF (xcpot%is_name("vwn")) THEN ! Vosko,Wilk,Nusair correlation
107 855 : CALL vxcvwn(iofile,xcpot%data%krla,jspins, ngrid,ngrid,rh(:ngrid,:), vx(:ngrid,:),vxc(:ngrid,:))
108 127 : ELSEIF (xcpot%is_name("pz")) THEN ! Perdew,Zunger correlation
109 127 : CALL vxcpz(iofile,xcpot%data%krla,jspins, ngrid,ngrid,rh(:ngrid,:), vx(:ngrid,:),vxc(:ngrid,:))
110 0 : ELSEIF (xcpot%is_name("hf")) THEN
111 : ! Hartree-Fock calculation: X-alpha potential is added to generate a rational local potential,
112 : ! later it is subtracted again
113 : ! CALL juDFT_error('HF should now be treated as a GGA functional', calledby='xcpot_get_vxc')
114 0 : CALL vxcxal(xcpot%data%krla,jspins, ngrid,ngrid,rh(:ngrid,:), vx(:ngrid,:),vxc(:ngrid,:))
115 : ! vxc=0
116 0 : ELSEIF (xcpot%is_name("exx")) THEN
117 : ! if exact exchange calculation do nothing
118 0 : vxc = 0
119 : ELSE
120 0 : CALL juDFT_error("Unknown LDA potential",calledby="type xcpot")
121 : ENDIF
122 : ENDIF
123 : !
124 : !-----> hartree units
125 : !
126 151278704 : vx = hrtr_half*vx
127 151278704 : vxc = hrtr_half*vxc
128 :
129 2914 : END SUBROUTINE xcpot_get_vxc
130 :
131 : !***********************************************************************
132 984 : SUBROUTINE xcpot_get_exc(xcpot,jspins,rh,exc,grad,kinEnergyDen_KS, mt_call)
133 : !***********************************************************************
134 : USE m_xcxal, ONLY : excxal
135 : USE m_xcwgn, ONLY : excwgn
136 : USE m_xcbh, ONLY : excbh
137 : USE m_xcvwn, ONLY : excvwn
138 : USE m_xcpz, ONLY : excpz
139 : USE m_excl91
140 : USE m_excwb91
141 : USE m_excpw91
142 : USE m_excepbe
143 : IMPLICIT NONE
144 :
145 : CLASS(t_xcpot_inbuild),INTENT(IN) :: xcpot
146 : INTEGER, INTENT (IN) :: jspins
147 : REAL,INTENT (IN) :: rh(:,:)
148 : REAL, INTENT (OUT) :: exc(:)
149 : TYPE(t_gradients),OPTIONAL,INTENT(IN) ::grad
150 : LOGICAL, OPTIONAL, INTENT(IN) :: mt_call
151 : REAL, INTENT(IN), OPTIONAL :: kinEnergyDen_KS(:,:)
152 :
153 : !c
154 : !c ---> local scalars
155 : INTEGER :: ngrid
156 : REAL, PARAMETER :: hrtr_half = 0.5
157 :
158 : !used to be dummy arguments for testing
159 : INTEGER,PARAMETER :: idsprs=0,isprsv=0,iofile=6
160 : REAL,PARAMETER :: sprsv=0.0
161 : LOGICAL,PARAMETER :: lwbc=.false. ! l-white-bird-current (ta)
162 : !c
163 : !c-----> determine exchange correlation energy density
164 : !c
165 98876487 : exc(:) = 0.0
166 984 : ngrid=SIZE(rh,1)
167 984 : IF (xcpot%exc_is_gga()) THEN
168 807 : IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_exc for a GGA potential without providing derivatives")
169 807 : IF (xcpot%is_name("l91")) THEN ! local pw91
170 0 : CALL excl91(jspins,ngrid,ngrid,rh(:ngrid,:),grad%agrt,grad%agru,grad%agrd,grad%g2rt,grad%g2ru,grad%g2rd,grad%gggrt,grad%gggru,grad%gggrd,grad%gzgr, exc, isprsv,sprsv)
171 807 : ELSEIF (xcpot%is_name("pw91")) THEN ! pw91
172 : IF (lwbc) THEN
173 : CALL excwb91(ngrid,ngrid,rh(:ngrid,1),rh(:ngrid,2),grad%agrt,grad%agru,grad%agrd, grad%g2rt,grad%g2ru,grad%g2rd,grad%gggrt,grad%gggru,grad%gggrd,grad%gzgr, exc, idsprs,isprsv,sprsv)
174 : ELSE
175 0 : CALL excpw91(jspins,ngrid,ngrid,rh(:ngrid,:),grad%agrt,grad%agru,grad%agrd, grad%g2rt,grad%g2ru,grad%g2rd,grad%gggrt,grad%gggru,grad%gggrd,grad%gzgr, exc, idsprs,isprsv,sprsv)
176 : ENDIF
177 : ELSE
178 807 : CALL excepbe(xcpot%data,jspins,ngrid,ngrid, rh(:ngrid,:),grad%agrt,grad%agru,grad%agrd,grad%g2ru,grad%g2rd,grad%gggrt,grad%gggru,grad%gggrd, exc)
179 : ENDIF
180 : ELSE !LDA
181 177 : IF (xcpot%is_name("x-a")) THEN ! X-alpha method
182 0 : CALL excxal(iofile,xcpot%data%krla,jspins, ngrid,ngrid,rh, exc)
183 177 : ELSEIF (xcpot%is_name("wign")) THEN ! Wigner interpolation formula
184 0 : CALL excwgn(iofile,xcpot%data%krla,jspins, ngrid,ngrid,rh, exc)
185 177 : ELSEIF (xcpot%is_name("mjw").OR.xcpot%is_name("bh")) THEN ! von Barth,Hedin correlation
186 0 : CALL excbh(iofile,xcpot%data,jspins, ngrid,ngrid,rh, exc)
187 177 : ELSEIF (xcpot%is_name("vwn")) THEN ! Vosko,Wilk,Nusair correlation
188 162 : CALL excvwn(iofile,xcpot%data%krla,jspins, ngrid,ngrid,rh, exc)
189 15 : ELSEIF (xcpot%is_name("pz")) THEN ! Perdew,Zunger correlation
190 15 : CALL excpz(iofile,xcpot%data%krla,jspins, ngrid,ngrid,rh, exc)
191 0 : ELSEIF (xcpot%is_name("hf")) THEN
192 : ! CALL juDFT_error('HF should now be treated as a GGA functional', calledby='xcpot_get_exc')
193 : ! exc=0
194 0 : CALL excxal(iofile,xcpot%data%krla,jspins, ngrid,ngrid,rh, exc)
195 0 : ELSEIF (xcpot%is_name("exx")) THEN
196 0 : CALL juDFT_error('EXX should now be treated as a GGA functional', calledby='xcpot_get_exc')
197 : ELSE
198 0 : CALL juDFT_error("Unknown LDA potential",calledby="type xcpot")
199 : ENDIF
200 : ENDIF
201 : !c-----> hartree units
202 98876487 : exc= hrtr_half*exc
203 :
204 984 : END SUBROUTINE xcpot_get_exc
205 :
206 160 : END MODULE m_types_xcpot_inbuild
|
