51#include "./base/base_uses.f90"
57 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'atom_xc'
77 REAL(kind=
dp),
DIMENSION(:),
INTENT(INOUT) :: ext_density
82 CHARACTER(LEN=*),
PARAMETER :: routinen =
'calculate_atom_zmp'
84 INTEGER :: extunit, handle, ir, nr, z
85 REAL(kind=
dp) :: int1, int2
86 REAL(kind=
dp),
DIMENSION(:),
POINTER :: deltarho, rho_dum, vxc, vxc1, vxc2
87 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: rho
89 CALL timeset(routinen, handle)
91 nr =
atom%basis%grid%nr
93 ALLOCATE (rho(nr, 1), vxc(nr), vxc1(nr), vxc2(nr), rho_dum(nr), deltarho(nr))
103 rho_dum = rho(:, 1)*int1/z
104 deltarho = rho_dum - ext_density
108 vxc2 = vxc2*
atom%lambda
117 CALL open_file(file_name=
"linear_potentials.dat", file_status=
"UNKNOWN", &
118 file_form=
"FORMATTED", file_action=
"WRITE", &
121 WRITE (extunit, fmt=
'("#",T10,"R[bohr]",T36,"Rho[au]",T61,"DRho[au]",T86,"V_XC[au]",T111,"V_XC1[au]",T136,"V_XC2[au]")')
123 WRITE (extunit, fmt=
'(T1,E24.15,T26,E24.15,T51,E24.15,T76,E24.15,T101,E24.15,T126,E24.15)') &
124 atom%basis%grid%rad(ir), rho(ir, 1), deltarho(ir), vxc(ir), vxc1(ir), vxc2(ir)
131 DEALLOCATE (rho, vxc, vxc1, vxc2, rho_dum, deltarho)
133 CALL timestop(handle)
146 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: vxc
148 LOGICAL,
INTENT(in) :: lprint
149 TYPE(
opmat_type),
INTENT(inout),
OPTIONAL,
POINTER :: xcmat
151 CHARACTER(LEN=*),
PARAMETER :: routinen =
'calculate_atom_ext_vxc'
153 INTEGER :: extunit, handle, ir, nr
154 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: rho
156 CALL timeset(routinen, handle)
157 nr =
atom%basis%grid%nr
159 ALLOCATE (rho(nr, 1))
164 CALL open_file(file_name=
"linear_potentials.dat", file_status=
"UNKNOWN", &
165 file_form=
"FORMATTED", file_action=
"WRITE", &
168 WRITE (extunit, fmt=
'("#",T10,"R[bohr]",T36,"Rho[au]",T61,"V_XC[au]")')
170 WRITE (extunit, fmt=
'(T1,E24.15,T26,E24.15,T51,E24.15)') &
171 atom%basis%grid%rad(ir), rho(ir, 1), vxc(ir)
181 CALL timestop(handle)
200 CHARACTER(LEN=*),
PARAMETER :: routinen =
'calculate_atom_vxc_lda'
202 INTEGER :: deriv_order, handle, i, l, myfun, n1, &
203 n2, n3, nr, nspins, unit_nr
204 INTEGER,
DIMENSION(2, 3) :: bounds
206 REAL(kind=
dp) :: density_cut, gradient_cut, tau_cut
207 REAL(kind=
dp),
DIMENSION(:),
POINTER :: exc, vxc
208 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: drho, lap, rho, tau
209 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER :: taumat, xcpot
216 CALL timeset(routinen, handle)
220 nlcc =
atom%potential%gth_pot%nlcc
222 nlcc =
atom%potential%upf_pot%core_correction
224 nlcc =
atom%potential%sgp_pot%has_nlcc
227 IF (
ASSOCIATED(xc_section))
THEN
232 atom%energy%exc = 0._dp
247 nr =
atom%basis%grid%nr
255 drho_cutoff=gradient_cut, tau_cutoff=tau_cut)
259 NULLIFY (rho, drho, tau)
261 ALLOCATE (rho(nr, 1))
267 IF (needs%norm_drho)
THEN
268 ALLOCATE (drho(nr, 1))
275 ALLOCATE (tau(nr, 1))
277 typ=
"KIN", rr=
atom%basis%grid%rad2)
279 IF (needs%laplace_rho)
THEN
280 ALLOCATE (lap(nr, 1))
282 typ=
"LAP", rr=
atom%basis%grid%rad2)
288 CALL fill_rho_set(rho_set, nspins, needs, rho, drho, tau, lap, nr)
294 deriv_order=deriv_order)
303 CALL open_file(unit_number=unit_nr, file_status=
"UNKNOWN", file_action=
"WRITE", file_name=
"atom.dat")
304 DO i = 1,
SIZE(xcpot(:, 1, 1))
305 WRITE (unit_nr, *)
atom%basis%grid%rad(i), rho(i, 1), xcpot(i, 1, 1)
315 CALL open_file(unit_number=unit_nr, file_status=
"UNKNOWN", file_action=
"WRITE", file_name=
"atompot.dat")
316 DO i = 1,
SIZE(xcpot(:, 1, 1))
317 WRITE (unit_nr, *)
atom%basis%grid%rad(i), rho(i, 1), xcpot(i, 1, 1)
323 IF (needs%norm_drho)
THEN
328 CALL open_file(unit_number=unit_nr, file_status=
"UNKNOWN", file_action=
"WRITE", file_name=
"atomdpot.dat")
329 DO i = 1,
SIZE(xcpot(:, 1, 1))
330 WRITE (unit_nr, *)
atom%basis%grid%rad(i), drho(i, 1), xcpot(i, 1, 1)
339 n1 =
SIZE(xcmat%op, 1)
340 n2 =
SIZE(xcmat%op, 2)
341 n3 =
SIZE(xcmat%op, 3)
342 ALLOCATE (taumat(n1, n2, 0:n3 - 1))
345 xcpot(:, 1, 1) = 0.5_dp*xcpot(:, 1, 1)
347 xcpot(:, 1, 1) = xcpot(:, 1, 1)/
atom%basis%grid%rad2(:)
350 xcmat%op(:, :, l) = xcmat%op(:, :, l) + real(l*(l + 1),
dp)*taumat(:, :, l)
358 IF (needs%laplace_rho)
THEN
371 nr =
atom%basis%grid%nr
372 ALLOCATE (rho(nr, 1), exc(nr), vxc(nr))
378 CALL lda_pade(rho(:, 1), exc, vxc)
383 DEALLOCATE (rho, exc, vxc)
387 CALL timestop(handle)
405 CHARACTER(LEN=*),
PARAMETER :: routinen =
'calculate_atom_vxc_lsd'
407 INTEGER :: deriv_order, handle, l, myfun, n1, n2, &
409 INTEGER,
DIMENSION(2, 3) :: bounds
411 REAL(kind=
dp) :: density_cut, gradient_cut, tau_cut
412 REAL(kind=
dp),
DIMENSION(:),
POINTER :: exc, vxca, vxcb, xfun
413 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: drho, lap, rho, tau
414 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER :: taumat, xcpot
421 CALL timeset(routinen, handle)
425 nlcc =
atom%potential%gth_pot%nlcc
427 nlcc =
atom%potential%upf_pot%core_correction
430 nlcc =
atom%potential%sgp_pot%has_nlcc
434 IF (
ASSOCIATED(xc_section))
THEN
436 nr =
atom%basis%grid%nr
444 atom%energy%exc = 0._dp
459 nr =
atom%basis%grid%nr
467 drho_cutoff=gradient_cut, tau_cutoff=tau_cut)
471 NULLIFY (rho, drho, tau)
472 IF (needs%rho_spin)
THEN
473 ALLOCATE (rho(nr, 2))
479 rho(:, 1) = rho(:, 1) + 0.5_dp*xfun(:)
480 rho(:, 2) = rho(:, 2) + 0.5_dp*xfun(:)
483 IF (needs%norm_drho_spin)
THEN
484 ALLOCATE (drho(nr, 2))
490 drho(:, 1) = drho(:, 1) + 0.5_dp*xfun(:)
491 drho(:, 2) = drho(:, 2) + 0.5_dp*xfun(:)
494 IF (needs%tau_spin)
THEN
495 ALLOCATE (tau(nr, 2))
497 typ=
"KIN", rr=
atom%basis%grid%rad2)
499 typ=
"KIN", rr=
atom%basis%grid%rad2)
501 IF (needs%laplace_rho_spin)
THEN
502 ALLOCATE (lap(nr, 2))
504 typ=
"LAP", rr=
atom%basis%grid%rad2)
506 typ=
"LAP", rr=
atom%basis%grid%rad2)
510 lap(:, 1) = lap(:, 1) + 0.5_dp*xfun(:)
511 lap(:, 2) = lap(:, 2) + 0.5_dp*xfun(:)
515 CALL fill_rho_set(rho_set, nspins, needs, rho, drho, tau, lap, nr)
521 deriv_order=deriv_order)
528 IF (needs%rho_spin)
THEN
537 IF (needs%norm_drho_spin)
THEN
551 IF (
ASSOCIATED(deriv))
THEN
558 IF (needs%tau_spin)
THEN
559 n1 =
SIZE(xcmata%op, 1)
560 n2 =
SIZE(xcmata%op, 2)
561 n3 =
SIZE(xcmata%op, 3)
562 ALLOCATE (taumat(n1, n2, 0:n3 - 1))
567 xcpot(:, 1, 1) = 0.5_dp*xcpot(:, 1, 1)
569 xcpot(:, 1, 1) = xcpot(:, 1, 1)/
atom%basis%grid%rad2(:)
572 xcmata%op(:, :, l) = xcmata%op(:, :, l) + real(l*(l + 1),
dp)*taumat(:, :, l)
578 xcpot(:, 1, 1) = 0.5_dp*xcpot(:, 1, 1)
580 xcpot(:, 1, 1) = xcpot(:, 1, 1)/
atom%basis%grid%rad2(:)
583 xcmatb%op(:, :, l) = xcmatb%op(:, :, l) + real(l*(l + 1),
dp)*taumat(:, :, l)
591 IF (needs%laplace_rho_spin)
THEN
601 IF (nlcc)
DEALLOCATE (xfun)
606 nr =
atom%basis%grid%nr
607 ALLOCATE (rho(nr, 2), exc(nr), vxca(nr), vxcb(nr))
608 IF (nlcc)
ALLOCATE (xfun(nr))
615 rho(:, 1) = rho(:, 1) + 0.5_dp*xfun(:)
616 rho(:, 2) = rho(:, 2) + 0.5_dp*xfun(:)
618 CALL lsd_pade(rho(:, 1), rho(:, 2), exc, vxca, vxcb)
624 DEALLOCATE (rho, exc, vxca, vxcb)
625 IF (nlcc)
DEALLOCATE (xfun)
629 CALL timestop(handle)
647 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(IN) :: pmat
648 INTEGER,
INTENT(IN) :: maxl
650 REAL(kind=
dp),
INTENT(OUT) :: fexc
651 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: xcmat
653 CHARACTER(LEN=*),
PARAMETER :: routinen =
'atom_vxc_lda'
655 INTEGER :: deriv_order, handle, l, myfun, n1, n2, &
657 INTEGER,
DIMENSION(2, 3) :: bounds
659 REAL(kind=
dp) :: density_cut, gradient_cut, tau_cut
660 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: drho, lap, rho, tau
661 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER :: taumat, xcpot
668 CALL timeset(routinen, handle)
670 cpassert(
ASSOCIATED(xc_section))
699 drho_cutoff=gradient_cut, tau_cutoff=tau_cut)
703 NULLIFY (rho, drho, tau)
705 ALLOCATE (rho(nr, 1))
706 CALL atom_density(rho(:, 1), pmat, basis, maxl, typ=
"RHO")
708 IF (needs%norm_drho)
THEN
709 ALLOCATE (drho(nr, 1))
710 CALL atom_density(drho(:, 1), pmat, basis, maxl, typ=
"DER")
713 ALLOCATE (tau(nr, 1))
714 CALL atom_density(tau(:, 1), pmat, basis, maxl, typ=
"KIN", rr=basis%grid%rad2)
716 IF (needs%laplace_rho)
THEN
717 ALLOCATE (lap(nr, 1))
718 CALL atom_density(lap(:, 1), pmat, basis, maxl, typ=
"LAP", rr=basis%grid%rad2)
721 CALL fill_rho_set(rho_set, nspins, needs, rho, drho, tau, lap, nr)
727 deriv_order=deriv_order)
740 IF (needs%norm_drho)
THEN
752 ALLOCATE (taumat(n1, n2, 0:n3 - 1))
755 xcpot(:, 1, 1) = 0.5_dp*xcpot(:, 1, 1)
757 xcpot(:, 1, 1) = xcpot(:, 1, 1)/basis%grid%rad2(:)
760 xcmat(:, :, l) = xcmat(:, :, l) + real(l*(l + 1),
dp)*taumat(:, :, l)
768 IF (needs%laplace_rho)
THEN
778 CALL timestop(handle)
796 SUBROUTINE atom_vxc_lsd(basis, pmata, pmatb, maxl, xc_section, fexc, xcmata, xcmatb)
798 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(IN) :: pmata, pmatb
799 INTEGER,
INTENT(IN) :: maxl
801 REAL(kind=
dp),
INTENT(OUT) :: fexc
802 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: xcmata, xcmatb
804 CHARACTER(LEN=*),
PARAMETER :: routinen =
'atom_vxc_lsd'
806 INTEGER :: deriv_order, handle, l, myfun, n1, n2, &
808 INTEGER,
DIMENSION(2, 3) :: bounds
810 REAL(kind=
dp) :: density_cut, gradient_cut, tau_cut
811 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: drho, lap, rho, tau
812 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER :: taumat, xcpot
819 CALL timeset(routinen, handle)
821 cpassert(
ASSOCIATED(xc_section))
850 drho_cutoff=gradient_cut, tau_cutoff=tau_cut)
854 NULLIFY (rho, drho, tau)
855 IF (needs%rho_spin)
THEN
856 ALLOCATE (rho(nr, 2))
857 CALL atom_density(rho(:, 1), pmata, basis, maxl, typ=
"RHO")
858 CALL atom_density(rho(:, 2), pmatb, basis, maxl, typ=
"RHO")
860 IF (needs%norm_drho_spin)
THEN
861 ALLOCATE (drho(nr, 2))
862 CALL atom_density(drho(:, 1), pmata, basis, maxl, typ=
"DER")
863 CALL atom_density(drho(:, 2), pmatb, basis, maxl, typ=
"DER")
865 IF (needs%tau_spin)
THEN
866 ALLOCATE (tau(nr, 2))
867 CALL atom_density(tau(:, 1), pmata, basis, maxl, typ=
"KIN", rr=basis%grid%rad2)
868 CALL atom_density(tau(:, 2), pmatb, basis, maxl, typ=
"KIN", rr=basis%grid%rad2)
870 IF (needs%laplace_rho_spin)
THEN
871 ALLOCATE (lap(nr, 2))
872 CALL atom_density(lap(:, 1), pmata, basis, maxl, typ=
"LAP", rr=basis%grid%rad2)
873 CALL atom_density(lap(:, 2), pmatb, basis, maxl, typ=
"LAP", rr=basis%grid%rad2)
876 CALL fill_rho_set(rho_set, nspins, needs, rho, drho, tau, lap, nr)
882 deriv_order=deriv_order)
889 IF (needs%rho_spin)
THEN
898 IF (needs%norm_drho_spin)
THEN
912 IF (
ASSOCIATED(deriv))
THEN
919 IF (needs%tau_spin)
THEN
923 ALLOCATE (taumat(n1, n2, 0:n3 - 1))
928 xcpot(:, 1, 1) = 0.5_dp*xcpot(:, 1, 1)
930 xcpot(:, 1, 1) = xcpot(:, 1, 1)/basis%grid%rad2(:)
933 xcmata(:, :, l) = xcmata(:, :, l) + real(l*(l + 1),
dp)*taumat(:, :, l)
939 xcpot(:, 1, 1) = 0.5_dp*xcpot(:, 1, 1)
941 xcpot(:, 1, 1) = xcpot(:, 1, 1)/basis%grid%rad2(:)
944 xcmatb(:, :, l) = xcmatb(:, :, l) + real(l*(l + 1),
dp)*taumat(:, :, l)
957 CALL timestop(handle)
975 SUBROUTINE atom_dpot_lda(basis0, pmat0, basis1, pmat1, maxl, functional, dfexc, linxpar)
977 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(IN) :: pmat0
979 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(IN) :: pmat1
980 INTEGER,
INTENT(IN) :: maxl
981 CHARACTER(LEN=*),
INTENT(IN) :: functional
982 REAL(kind=
dp),
INTENT(OUT) :: dfexc
983 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN),
OPTIONAL :: linxpar
985 CHARACTER(LEN=*),
PARAMETER :: routinen =
'atom_dpot_lda'
986 REAL(kind=
dp),
PARAMETER :: alx = 0.20_dp, blx = -0.06_dp, &
987 fs = -0.75_dp*(3._dp/
pi)**(1._dp/3._dp)
989 INTEGER :: handle, ir, nr
990 REAL(kind=
dp) :: a, b, fx
991 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: delta, drho0, drho1, pot0, pot1, rho0, &
994 CALL timeset(routinen, handle)
998 ALLOCATE (rho0(nr), drho0(nr))
1000 CALL atom_density(drho0, pmat0, basis0, maxl, typ=
"DER")
1002 ALLOCATE (rho1(nr), drho1(nr))
1003 CALL atom_density(rho1, pmat1, basis1, maxl, typ=
"RHO")
1005 CALL atom_density(drho1, pmat1, basis1, maxl, typ=
"DER")
1007 ALLOCATE (delta(nr))
1009 delta(1:nr) = fs*(rho0(1:nr)**fx - rho1(1:nr)**fx)
1011 SELECT CASE (trim(functional))
1013 IF (
PRESENT(linxpar))
THEN
1020 ALLOCATE (pot0(nr), pot1(nr))
1022 IF (rho0(ir) > 1.e-12_dp)
THEN
1023 pot0(ir) = 0.5_dp*drho0(ir)/(3._dp*
pi*
pi*rho0(ir)**fx)
1028 pot1(1:nr) = 1._dp + (a*pot0(1:nr)**2)/(1._dp + b*pot0(1:nr)**2)
1029 pot1(1:nr) = pot1(1:nr)*delta(1:nr)
1031 DEALLOCATE (pot0, pot1)
1033 cpabort(
"Unknown functional in atom_dpot_lda")
1036 DEALLOCATE (rho0, rho1, drho0, drho1, delta)
1038 CALL timestop(handle)
1057 SUBROUTINE fill_rho_set(rho_set, nspins, needs, rho, drho, tau, lap, na)
1060 INTEGER,
INTENT(IN) :: nspins
1062 REAL(
dp),
DIMENSION(:, :),
POINTER :: rho, drho, tau, lap
1063 INTEGER,
INTENT(IN) :: na
1065 REAL(kind=
dp),
PARAMETER :: f13 = (1.0_dp/3.0_dp)
1069 SELECT CASE (nspins)
1071 cpassert(.NOT. needs%rho_spin)
1072 cpassert(.NOT. needs%drho_spin)
1073 cpassert(.NOT. needs%norm_drho_spin)
1074 cpassert(.NOT. needs%rho_spin_1_3)
1075 cpassert(.NOT. needs%tau_spin)
1076 cpassert(.NOT. needs%drho)
1078 IF (needs%rho_1_3)
THEN
1080 rho_set%rho_1_3(ia, 1, 1) = max(rho(ia, 1), 0.0_dp)**f13
1082 rho_set%owns%rho_1_3 = .true.
1083 rho_set%has%rho_1_3 = .true.
1088 rho_set%rho(ia, 1, 1) = rho(ia, 1)
1090 rho_set%owns%rho = .true.
1091 rho_set%has%rho = .true.
1094 IF (needs%norm_drho)
THEN
1096 rho_set%norm_drho(ia, 1, 1) = drho(ia, 1)
1098 rho_set%owns%norm_drho = .true.
1099 rho_set%has%norm_drho = .true.
1102 cpassert(.NOT. needs%drho)
1103 cpassert(.NOT. needs%drho_spin)
1107 rho_set%rho(ia, 1, 1) = rho(ia, 1) + rho(ia, 2)
1109 rho_set%owns%rho = .true.
1110 rho_set%has%rho = .true.
1113 IF (needs%norm_drho)
THEN
1115 rho_set%norm_drho(ia, 1, 1) = drho(ia, 1) + drho(ia, 2)
1117 rho_set%owns%norm_drho = .true.
1118 rho_set%has%norm_drho = .true.
1121 IF (needs%rho_spin)
THEN
1123 rho_set%rhoa(ia, 1, 1) = rho(ia, 1)
1124 rho_set%rhob(ia, 1, 1) = rho(ia, 2)
1126 rho_set%owns%rho_spin = .true.
1127 rho_set%has%rho_spin = .true.
1130 IF (needs%rho_spin_1_3)
THEN
1132 rho_set%rhoa_1_3(ia, 1, 1) = max(rho(ia, 1), 0.0_dp)**f13
1133 rho_set%rhob_1_3(ia, 1, 1) = max(rho(ia, 2), 0.0_dp)**f13
1135 rho_set%owns%rho_1_3 = .true.
1136 rho_set%has%rho_1_3 = .true.
1139 IF (needs%norm_drho_spin)
THEN
1141 rho_set%norm_drhoa(ia, 1, 1) = drho(ia, 1)
1142 rho_set%norm_drhob(ia, 1, 1) = drho(ia, 2)
1144 rho_set%owns%norm_drho_spin = .true.
1145 rho_set%has%norm_drho_spin = .true.
1152 IF (nspins == 2)
THEN
1154 rho_set%tau(ia, 1, 1) = tau(ia, 1) + tau(ia, 2)
1156 rho_set%owns%tau = .true.
1157 rho_set%has%tau = .true.
1160 rho_set%tau(ia, 1, 1) = tau(ia, 1)
1162 rho_set%owns%tau = .true.
1163 rho_set%has%tau = .true.
1166 IF (needs%tau_spin)
THEN
1167 cpassert(nspins == 2)
1169 rho_set%tau_a(ia, 1, 1) = tau(ia, 1)
1170 rho_set%tau_b(ia, 1, 1) = tau(ia, 2)
1172 rho_set%owns%tau_spin = .true.
1173 rho_set%has%tau_spin = .true.
1177 IF (needs%laplace_rho)
THEN
1178 IF (nspins == 2)
THEN
1180 rho_set%laplace_rho(ia, 1, 1) = lap(ia, 1) + lap(ia, 2)
1182 rho_set%owns%laplace_rho = .true.
1183 rho_set%has%laplace_rho = .true.
1186 rho_set%laplace_rho(ia, 1, 1) = lap(ia, 1)
1188 rho_set%owns%laplace_rho = .true.
1189 rho_set%has%laplace_rho = .true.
1192 IF (needs%laplace_rho_spin)
THEN
1193 cpassert(nspins == 2)
1195 rho_set%laplace_rhoa(ia, 1, 1) = lap(ia, 1)
1196 rho_set%laplace_rhob(ia, 1, 1) = lap(ia, 2)
1198 rho_set%owns%laplace_rho_spin = .true.
1199 rho_set%has%laplace_rho_spin = .true.
1202 END SUBROUTINE fill_rho_set
1213 PURE SUBROUTINE lda_pade(rho, exc, vxc)
1215 REAL(
dp),
DIMENSION(:),
INTENT(IN) :: rho
1216 REAL(
dp),
DIMENSION(:),
INTENT(OUT) :: exc, vxc
1218 REAL(kind=
dp),
PARAMETER :: a0 = 0.4581652932831429e+0_dp, a1 = 0.2217058676663745e+1_dp, &
1219 a2 = 0.7405551735357053e+0_dp, a3 = 0.1968227878617998e-1_dp, &
1220 b1 = 1.0000000000000000e+0_dp, b2 = 0.4504130959426697e+1_dp, &
1221 b3 = 0.1110667363742916e+1_dp, b4 = 0.2359291751427506e-1_dp, f13 = (1.0_dp/3.0_dp), &
1222 rsfac = 0.6203504908994000166680065_dp
1225 REAL(kind=
dp) :: depade, dpv, dq, epade, p, q, rs
1232 IF (rho(i) > 1.e-20_dp)
THEN
1233 rs = rsfac*rho(i)**(-f13)
1234 p = a0 + (a1 + (a2 + a3*rs)*rs)*rs
1235 q = (b1 + (b2 + (b3 + b4*rs)*rs)*rs)*rs
1238 dpv = a1 + (2.0_dp*a2 + 3.0_dp*a3*rs)*rs
1239 dq = b1 + (2.0_dp*b2 + (3.0_dp*b3 + 4.0_dp*b4*rs)*rs)*rs
1240 depade = f13*rs*(dpv*q - p*dq)/(q*q)
1242 exc(i) = epade*rho(i)
1243 vxc(i) = epade + depade
1247 END SUBROUTINE lda_pade
1260 PURE SUBROUTINE lsd_pade(rhoa, rhob, exc, vxca, vxcb)
1262 REAL(
dp),
DIMENSION(:),
INTENT(IN) :: rhoa, rhob
1263 REAL(
dp),
DIMENSION(:),
INTENT(OUT) :: exc, vxca, vxcb
1265 REAL(kind=
dp),
PARAMETER :: a0 = 0.4581652932831429e+0_dp, a1 = 0.2217058676663745e+1_dp, &
1266 a2 = 0.7405551735357053e+0_dp, a3 = 0.1968227878617998e-1_dp, &
1267 b1 = 1.0000000000000000e+0_dp, b2 = 0.4504130959426697e+1_dp, &
1268 b3 = 0.1110667363742916e+1_dp, b4 = 0.2359291751427506e-1_dp, &
1269 da0 = 0.119086804055547e+0_dp, da1 = 0.6157402568883345e+0_dp, &
1270 da2 = 0.1574201515892867e+0_dp, da3 = 0.3532336663397157e-2_dp, &
1271 db1 = 0.0000000000000000e+0_dp, db2 = 0.2673612973836267e+0_dp, &
1272 db3 = 0.2052004607777787e+0_dp, db4 = 0.4200005045691381e-2_dp, f13 = (1.0_dp/3.0_dp), &
1273 f43 = (4.0_dp/3.0_dp)
1274 REAL(kind=
dp),
PARAMETER :: fxfac = 1.923661050931536319759455_dp, &
1275 rsfac = 0.6203504908994000166680065_dp
1278 REAL(kind=
dp) :: dc, dpv, dq, dr, dx, fa0, fa1, fa2, fa3, &
1279 fb1, fb2, fb3, fb4, fx1, fx2, p, q, &
1280 rhoab, rs, x, xp, xq
1290 rhoab = rhoa(i) + rhob(i)
1291 IF (rhoab > 1.e-20_dp)
THEN
1292 rs = rsfac*rhoab**(-f13)
1294 x = (rhoa(i) - rhob(i))/rhoab
1295 IF (x < -1.0_dp)
THEN
1297 fx2 = -f43*fxfac*2.0_dp**f13
1298 ELSE IF (x > 1.0_dp)
THEN
1300 fx2 = f43*fxfac*2.0_dp**f13
1302 fx1 = ((1.0_dp + x)**f43 + (1.0_dp - x)**f43 - 2.0_dp)*fxfac
1303 fx2 = ((1.0_dp + x)**f13 - (1.0_dp - x)**f13)*fxfac*f43
1315 p = fa0 + (fa1 + (fa2 + fa3*rs)*rs)*rs
1316 q = (fb1 + (fb2 + (fb3 + fb4*rs)*rs)*rs)*rs
1317 dpv = fa1 + (2.0_dp*fa2 + 3.0_dp*fa3*rs)*rs
1318 dq = fb1 + (2.0_dp*fb2 + (3.0_dp*fb3 + &
1319 4.0_dp*fb4*rs)*rs)*rs
1320 xp = da0 + (da1 + (da2 + da3*rs)*rs)*rs
1321 xq = (db1 + (db2 + (db3 + db4*rs)*rs)*rs)*rs
1323 dr = (dpv*q - p*dq)/(q*q)
1324 dx = 2.0_dp*(xp*q - p*xq)/(q*q)*fx2/rhoab
1325 dc = f13*rs*dr - p/q
1328 vxca(i) = dc - dx*rhob(i)
1329 vxcb(i) = dc + dx*rhoa(i)
1333 END SUBROUTINE lsd_pade
Define the atom type and its sub types.
Some basic routines for atomic calculations.
subroutine, public atom_core_density(corden, potential, typ, rr)
...
subroutine, public atom_density(density, pmat, basis, maxl, typ, rr)
Map the electron density on an atomic radial grid.
subroutine, public numpot_matrix(imat, cpot, basis, derivatives)
Calculate a potential matrix by integrating the potential on an atomic radial grid.
subroutine, public coulomb_potential_numeric(cpot, density, grid)
Numerically compute the Coulomb potential on an atomic radial grid.
routines that build the integrals of the Vxc potential calculated for the atomic code
subroutine, public atom_dpot_lda(basis0, pmat0, basis1, pmat1, maxl, functional, dfexc, linxpar)
Estimate the ADMM exchange energy correction term using a model exchange functional.
subroutine, public atom_vxc_lsd(basis, pmata, pmatb, maxl, xc_section, fexc, xcmata, xcmatb)
Alternative subroutine that calculates atomic exchange-correlation potential in spin-polarized case.
subroutine, public calculate_atom_vxc_lda(xcmat, atom, xc_section)
Calculate atomic exchange-correlation potential in spin-restricted case.
subroutine, public calculate_atom_ext_vxc(vxc, atom, lprint, xcmat)
ZMP subroutine for the scf external density from the external v_xc.
subroutine, public calculate_atom_zmp(ext_density, atom, lprint, xcmat)
ZMP subroutine for the calculation of the effective constraint potential in the atomic code.
subroutine, public calculate_atom_vxc_lsd(xcmata, xcmatb, atom, xc_section)
Calculate atomic exchange-correlation potential in spin-polarized case.
subroutine, public atom_vxc_lda(basis, pmat, maxl, xc_section, fexc, xcmat)
Alternative subroutine that calculates atomic exchange-correlation potential in spin-restricted case.
Utility routines to open and close files.
subroutine, public open_file(file_name, unit_number, file_status, file_form, file_action, file_position, file_pad, file_access, debug)
Opens a file and returns its logical unit number.
subroutine, public close_file(unit_number, file_status)
Closes an open file given by its logical unit number.
Defines the basic variable types.
integer, parameter, public dp
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
real(kind=dp), parameter, public fourpi
subroutine, public xc_rho_set_atom_update(rho_set, needs, nspins, bo)
...
Module with functions to handle derivative descriptors. derivative description are strings have the f...
integer, parameter, public deriv_norm_drho
integer, parameter, public deriv_norm_drhoa
integer, parameter, public deriv_rhob
integer, parameter, public deriv_rhoa
integer, parameter, public deriv_tau
integer, parameter, public deriv_tau_b
integer, parameter, public deriv_tau_a
integer, parameter, public deriv_rho
integer, parameter, public deriv_norm_drhob
represent a group ofunctional derivatives
subroutine, public xc_dset_zero_all(deriv_set)
...
type(xc_derivative_type) function, pointer, public xc_dset_get_derivative(derivative_set, description, allocate_deriv)
returns the requested xc_derivative
subroutine, public xc_dset_release(derivative_set)
releases a derivative set
subroutine, public xc_dset_create(derivative_set, pw_pool, local_bounds)
creates a derivative set object
Provides types for the management of the xc-functionals and their derivatives.
subroutine, public xc_derivative_get(deriv, split_desc, order, deriv_data, accept_null_data)
returns various information on the given derivative
type(xc_rho_cflags_type) function, public xc_functionals_get_needs(functionals, lsd, calc_potential)
...
subroutine, public xc_functionals_eval(functionals, lsd, rho_set, deriv_set, deriv_order)
...
subroutine, public xc_rho_set_create(rho_set, local_bounds, rho_cutoff, drho_cutoff, tau_cutoff)
allocates and does (minimal) initialization of a rho_set
subroutine, public xc_rho_set_release(rho_set, pw_pool)
releases the given rho_set
Provides all information about a basis set.
Provides all information about an atomic kind.
A derivative set contains the different derivatives of a xc-functional in form of a linked list.
represent a derivative of a functional
contains a flag for each component of xc_rho_set, so that you can use it to tell which components you...
represent a density, with all the representation and data needed to perform a functional evaluation