838 SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspace, &
839 matrix_hz, matrix_pz, matrix_pz_admm, matrix_wz, &
840 zehartree, zexc, zexc_aux_fit, rhopz_r, p_env, ex_env, debug)
843 TYPE(
pw_r3d_rs_type),
DIMENSION(:),
POINTER :: vxc_rspace, vtau_rspace, vadmm_rspace
844 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_hz, matrix_pz, matrix_pz_admm, &
846 REAL(kind=
dp),
OPTIONAL :: zehartree, zexc, zexc_aux_fit
848 INTENT(INOUT),
OPTIONAL :: rhopz_r
851 LOGICAL,
INTENT(IN),
OPTIONAL :: debug
853 CHARACTER(LEN=*),
PARAMETER :: routinen =
'response_force'
855 CHARACTER(LEN=default_string_length) :: basis_type, unitstr
856 INTEGER :: handle, iounit, ispin, mspin, myfun, &
857 n_rep_hf, nao, nao_aux, natom, nder, &
859 LOGICAL :: debug_forces, debug_stress, distribute_fock_matrix, do_ex, do_hfx, gapw, gapw_xc, &
860 hfx_treat_lsd_in_core, resp_only, s_mstruct_changed, use_virial
861 REAL(kind=
dp) :: eh1, ehartree, ekin_mol, eps_filter, &
862 exc, exc_aux_fit, fconv, focc, &
863 hartree_gs, hartree_t
864 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: ftot1, ftot2, ftot3
865 REAL(kind=
dp),
DIMENSION(2) :: total_rho_gs, total_rho_t
866 REAL(kind=
dp),
DIMENSION(3) :: fodeb
867 REAL(kind=
dp),
DIMENSION(3, 3) :: h_stress, pv_loc, stdeb, sttot, sttot2
873 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_ht, matrix_pd, matrix_pza, &
875 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_h, matrix_p, mhd, mhx, mhy, mhz, &
876 mpa2, mpd, mpz, scrm2
880 TYPE(
hfx_type),
DIMENSION(:, :),
POINTER :: x_data
882 TYPE(
local_rho_type),
POINTER :: local_rho_set_f, local_rho_set_gs, &
883 local_rho_set_t, local_rho_set_vxc, &
888 POINTER :: sab_aux_fit, sab_orb
891 TYPE(
pw_c1d_gs_type) :: rho_tot_gspace, rho_tot_gspace_gs, rho_tot_gspace_t, &
892 rhoz_tot_gspace, v_hartree_gspace_gs, v_hartree_gspace_t, zv_hartree_gspace
893 TYPE(
pw_c1d_gs_type),
DIMENSION(:),
POINTER :: rho_g_aux, rho_g_gs, rho_g_t, rhoz_g, &
894 rhoz_g_aux, rhoz_g_xc
899 TYPE(
pw_r3d_rs_type) :: v_hartree_rspace_gs, v_hartree_rspace_t, &
900 vhxc_rspace, zv_hartree_rspace
901 TYPE(
pw_r3d_rs_type),
DIMENSION(:),
POINTER :: rho_r_aux, rho_r_gs, rho_r_t, rhoz_r, &
902 rhoz_r_aux, rhoz_r_xc, tau_r_aux, &
903 tauz_r, tauz_r_xc, v_xc, v_xc_tau
905 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
907 TYPE(
qs_rho_type),
POINTER :: rho, rho_aux_fit, rho_xc
912 CALL timeset(routinen, handle)
914 IF (
PRESENT(debug))
THEN
918 debug_forces = .false.
919 debug_stress = .false.
923 IF (logger%para_env%is_source())
THEN
930 IF (
PRESENT(ex_env)) do_ex = .true.
932 cpassert(
PRESENT(p_env))
935 NULLIFY (ks_env, sab_orb, virial)
940 dft_control=dft_control, &
944 nspins = dft_control%nspins
945 gapw = dft_control%qs_control%gapw
946 gapw_xc = dft_control%qs_control%gapw_xc
948 IF (debug_forces)
THEN
949 CALL get_qs_env(qs_env, natom=natom, atomic_kind_set=atomic_kind_set)
950 ALLOCATE (ftot1(3, natom))
955 use_virial = virial%pv_availability .AND. (.NOT. virial%pv_numer)
957 IF (use_virial .AND. do_ex)
THEN
958 CALL cp_abort(__location__,
"Stress Tensor not available for TDDFT calculations.")
961 fconv = 1.0e-9_dp*
pascal/cell%deth
962 IF (debug_stress .AND. use_virial)
THEN
963 sttot = virial%pv_virial
973 ALLOCATE (mpa(ispin)%matrix)
974 CALL dbcsr_create(mpa(ispin)%matrix, template=p_env%p1(ispin)%matrix)
975 CALL dbcsr_copy(mpa(ispin)%matrix, p_env%p1(ispin)%matrix)
976 CALL dbcsr_add(mpa(ispin)%matrix, ex_env%matrix_pe(ispin)%matrix, 1.0_dp, 1.0_dp)
977 CALL dbcsr_set(matrix_hz(ispin)%matrix, 0.0_dp)
983 IF (do_ex .OR. (gapw .OR. gapw_xc))
THEN
986 ALLOCATE (matrix_ht(ispin)%matrix)
987 CALL dbcsr_create(matrix_ht(ispin)%matrix, template=matrix_hz(ispin)%matrix)
988 CALL dbcsr_copy(matrix_ht(ispin)%matrix, matrix_hz(ispin)%matrix)
989 CALL dbcsr_set(matrix_ht(ispin)%matrix, 0.0_dp)
998 mpa2(1:nspins, 1:1) => mpa(1:nspins)
1000 matrix_name=
"KINETIC ENERGY MATRIX", &
1002 sab_orb=sab_orb, calculate_forces=.true., &
1003 debug_forces=debug_forces, debug_stress=debug_stress)
1007 CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s)
1010 DO ispin = 1, nspins
1011 ALLOCATE (scrm(ispin)%matrix)
1012 CALL dbcsr_create(scrm(ispin)%matrix, template=matrix_s(1)%matrix)
1013 CALL dbcsr_copy(scrm(ispin)%matrix, matrix_s(1)%matrix)
1014 CALL dbcsr_set(scrm(ispin)%matrix, 0.0_dp)
1017 CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, particle_set=particle_set, &
1018 atomic_kind_set=atomic_kind_set)
1020 ALLOCATE (matrix_p(nspins, 1), matrix_h(nspins, 1))
1021 DO ispin = 1, nspins
1022 matrix_p(ispin, 1)%matrix => mpa(ispin)%matrix
1023 matrix_h(ispin, 1)%matrix => scrm(ispin)%matrix
1025 matrix_h(1, 1)%matrix => scrm(1)%matrix
1028 CALL core_matrices(qs_env, matrix_h, matrix_p, .true., nder, &
1029 debug_forces=debug_forces, debug_stress=debug_stress)
1033 IF (dft_control%qs_control%do_kg)
THEN
1035 CALL get_qs_env(qs_env=qs_env, kg_env=kg_env, dbcsr_dist=dbcsr_dist)
1037 IF (use_virial)
THEN
1038 pv_loc = virial%pv_virial
1041 IF (debug_forces) fodeb(1:3) = force(1)%kinetic(1:3, 1)
1042 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1043 CALL build_tnadd_mat(kg_env=kg_env, matrix_p=matrix_p, force=force, virial=virial, &
1044 calculate_forces=.true., use_virial=use_virial, &
1045 qs_kind_set=qs_kind_set, atomic_kind_set=atomic_kind_set, &
1046 particle_set=particle_set, sab_orb=sab_orb, dbcsr_dist=dbcsr_dist)
1047 IF (debug_forces)
THEN
1048 fodeb(1:3) = force(1)%kinetic(1:3, 1) - fodeb(1:3)
1049 CALL para_env%sum(fodeb)
1050 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dTnadd ", fodeb
1052 IF (debug_stress .AND. use_virial)
THEN
1053 stdeb = fconv*(virial%pv_virial - stdeb)
1054 CALL para_env%sum(stdeb)
1055 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1060 IF (use_virial)
THEN
1061 virial%pv_ekinetic = virial%pv_ekinetic + (virial%pv_virial - pv_loc)
1067 DEALLOCATE (matrix_h)
1068 DEALLOCATE (matrix_p)
1076 DO ispin = 1, nspins
1077 ALLOCATE (scrm(ispin)%matrix)
1078 CALL dbcsr_create(scrm(ispin)%matrix, template=matrix_pz(1)%matrix)
1079 CALL dbcsr_copy(scrm(ispin)%matrix, matrix_pz(ispin)%matrix)
1080 CALL dbcsr_set(scrm(ispin)%matrix, 0.0_dp)
1083 IF (debug_forces)
THEN
1084 ALLOCATE (ftot2(3, natom))
1086 fodeb(1:3) = ftot2(1:3, 1) - ftot1(1:3, 1)
1087 CALL para_env%sum(fodeb)
1088 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: (T+Dz)*dHcore", fodeb
1090 IF (debug_stress .AND. use_virial)
THEN
1091 stdeb = fconv*(virial%pv_virial - sttot)
1092 CALL para_env%sum(stdeb)
1093 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1096 sttot2 = virial%pv_virial
1104 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, poisson_env=poisson_env)
1106 IF (dft_control%do_admm)
THEN
1108 xc_section => admm_env%xc_section_primary
1115 IF (gapw .OR. gapw_xc)
THEN
1116 NULLIFY (oce, sab_orb)
1117 CALL get_qs_env(qs_env=qs_env, oce=oce, sab_orb=sab_orb)
1119 NULLIFY (local_rho_set_gs)
1124 qs_kind_set, dft_control, para_env)
1125 CALL init_rho0(local_rho_set_gs, qs_env, dft_control%qs_control%gapw_control)
1128 qs_kind_set, oce, sab_orb, para_env)
1131 NULLIFY (local_rho_set_t)
1134 qs_kind_set, dft_control, para_env)
1135 CALL init_rho0(local_rho_set_t, qs_env, dft_control%qs_control%gapw_control, &
1139 qs_kind_set, oce, sab_orb, para_env)
1143 ALLOCATE (rho_r_gs(nspins), rho_g_gs(nspins))
1144 DO ispin = 1, nspins
1145 CALL auxbas_pw_pool%create_pw(rho_r_gs(ispin))
1146 CALL auxbas_pw_pool%create_pw(rho_g_gs(ispin))
1148 CALL auxbas_pw_pool%create_pw(rho_tot_gspace_gs)
1150 total_rho_gs = 0.0_dp
1151 CALL pw_zero(rho_tot_gspace_gs)
1152 DO ispin = 1, nspins
1154 rho=rho_r_gs(ispin), &
1155 rho_gspace=rho_g_gs(ispin), &
1156 soft_valid=(gapw .OR. gapw_xc), &
1157 total_rho=total_rho_gs(ispin))
1158 CALL pw_axpy(rho_g_gs(ispin), rho_tot_gspace_gs)
1163 CALL pw_axpy(local_rho_set_gs%rho0_mpole%rho0_s_gs, rho_tot_gspace_gs)
1164 IF (
ASSOCIATED(local_rho_set_gs%rho0_mpole%rhoz_cneo_s_gs))
THEN
1165 CALL pw_axpy(local_rho_set_gs%rho0_mpole%rhoz_cneo_s_gs, rho_tot_gspace_gs)
1167 IF (dft_control%qs_control%gapw_control%nopaw_as_gpw)
THEN
1168 CALL get_qs_env(qs_env=qs_env, rho_core=rho_core)
1169 CALL pw_axpy(rho_core, rho_tot_gspace_gs)
1172 CALL auxbas_pw_pool%create_pw(v_hartree_gspace_gs)
1173 CALL auxbas_pw_pool%create_pw(v_hartree_rspace_gs)
1174 NULLIFY (hartree_local_gs)
1177 CALL pw_poisson_solve(poisson_env, rho_tot_gspace_gs, hartree_gs, v_hartree_gspace_gs)
1178 CALL pw_transfer(v_hartree_gspace_gs, v_hartree_rspace_gs)
1179 CALL pw_scale(v_hartree_rspace_gs, v_hartree_rspace_gs%pw_grid%dvol)
1185 cpassert(.NOT. use_virial)
1186 IF (debug_forces) fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1)
1187 CALL vh_1c_gg_integrals(qs_env, hartree_gs, hartree_local_gs%ecoul_1c, local_rho_set_t, para_env, tddft=.true., &
1188 local_rho_set_2nd=local_rho_set_gs, core_2nd=.false.)
1191 local_rho_set=local_rho_set_t, local_rho_set_2nd=local_rho_set_gs)
1192 IF (debug_forces)
THEN
1193 fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1) - fodeb(1:3)
1194 CALL para_env%sum(fodeb)
1195 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: (T+Dz)*dVh[D^GS]PAWg0", fodeb
1198 IF (gapw .OR. gapw_xc)
THEN
1201 NULLIFY (local_rho_set_vxc)
1204 qs_kind_set, dft_control, para_env)
1206 qs_kind_set, oce, sab_orb, para_env)
1209 CALL calculate_vxc_atom(qs_env, .false., exc1=hartree_gs, xc_section_external=xc_section, &
1210 rho_atom_set_external=local_rho_set_vxc%rho_atom_set)
1214 CALL auxbas_pw_pool%create_pw(vhxc_rspace)
1218 IF (use_virial)
THEN
1219 pv_loc = virial%pv_virial
1222 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1223 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1224 IF (gapw .OR. gapw_xc)
THEN
1226 DO ispin = 1, nspins
1229 CALL pw_transfer(v_hartree_rspace_gs, vhxc_rspace)
1230 ELSEIF (gapw_xc)
THEN
1233 CALL integrate_v_rspace(v_rspace=vhxc_rspace, &
1234 hmat=scrm(ispin), pmat=mpa(ispin), &
1235 qs_env=qs_env, gapw=gapw, &
1236 calculate_forces=.true.)
1239 DO ispin = 1, nspins
1241 CALL pw_axpy(vxc_rspace(ispin), vhxc_rspace)
1242 CALL integrate_v_rspace(v_rspace=vhxc_rspace, &
1243 hmat=scrm(ispin), pmat=mpa(ispin), &
1244 qs_env=qs_env, gapw=(gapw .OR. gapw_xc), &
1245 calculate_forces=.true.)
1249 DO ispin = 1, nspins
1251 CALL pw_axpy(vxc_rspace(ispin), vhxc_rspace)
1252 CALL integrate_v_rspace(v_rspace=vhxc_rspace, &
1253 hmat=scrm(ispin), pmat=mpa(ispin), &
1254 qs_env=qs_env, gapw=gapw, calculate_forces=.true.)
1258 IF (debug_forces)
THEN
1259 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1260 CALL para_env%sum(fodeb)
1261 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: (T+Dz)*dVhxc[D^GS] ", fodeb
1263 IF (debug_stress .AND. use_virial)
THEN
1264 stdeb = fconv*(virial%pv_virial - pv_loc)
1265 CALL para_env%sum(stdeb)
1266 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1270 IF (gapw .OR. gapw_xc)
THEN
1272 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
1273 IF (gapw)
CALL update_ks_atom(qs_env, scrm, mpa, forces=.true., tddft=.false., &
1274 rho_atom_external=local_rho_set_gs%rho_atom_set)
1276 rho_atom_external=local_rho_set_vxc%rho_atom_set)
1277 IF (debug_forces)
THEN
1278 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
1279 CALL para_env%sum(fodeb)
1280 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: (T+Dz)*dVhxc[D^GS]PAW ", fodeb
1289 CALL auxbas_pw_pool%give_back_pw(v_hartree_gspace_gs)
1290 CALL auxbas_pw_pool%give_back_pw(v_hartree_rspace_gs)
1292 CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace_gs)
1293 IF (
ASSOCIATED(rho_r_gs))
THEN
1294 DO ispin = 1, nspins
1295 CALL auxbas_pw_pool%give_back_pw(rho_r_gs(ispin))
1297 DEALLOCATE (rho_r_gs)
1299 IF (
ASSOCIATED(rho_g_gs))
THEN
1300 DO ispin = 1, nspins
1301 CALL auxbas_pw_pool%give_back_pw(rho_g_gs(ispin))
1303 DEALLOCATE (rho_g_gs)
1307 IF (
ASSOCIATED(vtau_rspace))
THEN
1308 cpassert(.NOT. (gapw .OR. gapw_xc))
1309 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1310 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1311 DO ispin = 1, nspins
1312 CALL integrate_v_rspace(v_rspace=vtau_rspace(ispin), &
1313 hmat=scrm(ispin), pmat=mpa(ispin), &
1314 qs_env=qs_env, gapw=(gapw .OR. gapw_xc), &
1315 calculate_forces=.true., compute_tau=.true.)
1317 IF (debug_forces)
THEN
1318 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1319 CALL para_env%sum(fodeb)
1320 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dVxc_tau ", fodeb
1322 IF (debug_stress .AND. use_virial)
THEN
1323 stdeb = fconv*(virial%pv_virial - pv_loc)
1324 CALL para_env%sum(stdeb)
1325 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1329 CALL auxbas_pw_pool%give_back_pw(vhxc_rspace)
1332 IF (use_virial)
THEN
1333 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
1338 IF (dft_control%qs_control%do_kg)
THEN
1343 IF (use_virial)
THEN
1344 pv_loc = virial%pv_virial
1347 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1350 ekin_mol=ekin_mol, &
1351 calc_force=.true., &
1352 do_kernel=.false., &
1354 IF (debug_forces)
THEN
1355 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1356 CALL para_env%sum(fodeb)
1357 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*dVkg ", fodeb
1359 IF (debug_stress .AND. use_virial)
THEN
1362 stdeb = 1.0_dp*fconv*ekin_mol
1363 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1366 stdeb = fconv*(virial%pv_virial - pv_loc)
1367 CALL para_env%sum(stdeb)
1368 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1371 stdeb = fconv*virial%pv_xc
1372 CALL para_env%sum(stdeb)
1373 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1376 IF (use_virial)
THEN
1378 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
1389 ALLOCATE (rhoz_r(nspins), rhoz_g(nspins))
1390 DO ispin = 1, nspins
1391 CALL auxbas_pw_pool%create_pw(rhoz_r(ispin))
1392 CALL auxbas_pw_pool%create_pw(rhoz_g(ispin))
1394 CALL auxbas_pw_pool%create_pw(rhoz_tot_gspace)
1395 CALL auxbas_pw_pool%create_pw(zv_hartree_rspace)
1396 CALL auxbas_pw_pool%create_pw(zv_hartree_gspace)
1399 DO ispin = 1, nspins
1401 rho=rhoz_r(ispin), rho_gspace=rhoz_g(ispin), &
1403 CALL pw_axpy(rhoz_g(ispin), rhoz_tot_gspace)
1407 ALLOCATE (rhoz_r_xc(nspins), rhoz_g_xc(nspins))
1408 DO ispin = 1, nspins
1409 CALL auxbas_pw_pool%create_pw(rhoz_r_xc(ispin))
1410 CALL auxbas_pw_pool%create_pw(rhoz_g_xc(ispin))
1412 DO ispin = 1, nspins
1414 rho=rhoz_r_xc(ispin), rho_gspace=rhoz_g_xc(ispin), &
1419 IF (
ASSOCIATED(vtau_rspace))
THEN
1420 cpassert(.NOT. (gapw .OR. gapw_xc))
1423 ALLOCATE (tauz_r(nspins))
1424 CALL auxbas_pw_pool%create_pw(work_g)
1425 DO ispin = 1, nspins
1426 CALL auxbas_pw_pool%create_pw(tauz_r(ispin))
1428 rho=tauz_r(ispin), rho_gspace=work_g, &
1431 CALL auxbas_pw_pool%give_back_pw(work_g)
1436 IF (
PRESENT(rhopz_r))
THEN
1437 DO ispin = 1, nspins
1438 CALL pw_copy(rhoz_r(ispin), rhopz_r(ispin))
1445 IF (use_virial)
THEN
1448 CALL auxbas_pw_pool%create_pw(rho_tot_gspace)
1453 h_stress(:, :) = 0.0_dp
1461 density=rhoz_tot_gspace, &
1462 ehartree=ehartree, &
1463 vhartree=zv_hartree_gspace, &
1464 h_stress=h_stress, &
1465 aux_density=rho_tot_gspace)
1467 CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace)
1470 virial%pv_ehartree = virial%pv_ehartree + 2.0_dp*h_stress/real(para_env%num_pe,
dp)
1471 virial%pv_virial = virial%pv_virial + 2.0_dp*h_stress/real(para_env%num_pe,
dp)
1473 IF (debug_stress)
THEN
1474 stdeb = -1.0_dp*fconv*ehartree
1475 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1477 stdeb = -1.0_dp*fconv*ehartree
1478 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1480 stdeb = fconv*(h_stress/real(para_env%num_pe,
dp))
1481 CALL para_env%sum(stdeb)
1482 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1484 stdeb = fconv*(h_stress/real(para_env%num_pe,
dp))
1485 CALL para_env%sum(stdeb)
1486 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1493 DO ispin = 1, nspins
1495 vxc_rspace(ispin)%pw_grid%dvol
1497 IF (
ASSOCIATED(vtau_rspace))
THEN
1498 DO ispin = 1, nspins
1500 vtau_rspace(ispin)%pw_grid%dvol
1505 IF (dft_control%qs_control%do_kg)
THEN
1508 exc = exc - ekin_mol
1512 IF (debug_stress)
THEN
1513 stdeb = -1.0_dp*fconv*exc
1514 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1523 CALL pw_axpy(local_rho_set_t%rho0_mpole%rho0_s_gs, rhoz_tot_gspace)
1524 IF (
ASSOCIATED(local_rho_set_t%rho0_mpole%rhoz_cneo_s_gs))
THEN
1525 CALL pw_axpy(local_rho_set_t%rho0_mpole%rhoz_cneo_s_gs, rhoz_tot_gspace)
1528 CALL pw_poisson_solve(poisson_env, rhoz_tot_gspace, ehartree, zv_hartree_gspace)
1531 IF (gapw .OR. gapw_xc)
THEN
1535 IF (debug_forces) fodeb(1:3) = force(1)%rho_core(1:3, 1)
1536 IF (debug_stress .AND. use_virial) stdeb = virial%pv_ehartree
1537 CALL pw_transfer(zv_hartree_gspace, zv_hartree_rspace)
1538 CALL pw_scale(zv_hartree_rspace, zv_hartree_rspace%pw_grid%dvol)
1540 CALL integrate_v_core_rspace(zv_hartree_rspace, qs_env)
1541 IF (debug_forces)
THEN
1542 fodeb(1:3) = force(1)%rho_core(1:3, 1) - fodeb(1:3)
1543 CALL para_env%sum(fodeb)
1544 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Vh(rhoz)*dncore ", fodeb
1546 IF (debug_stress .AND. use_virial)
THEN
1547 stdeb = fconv*(virial%pv_ehartree - stdeb)
1548 CALL para_env%sum(stdeb)
1549 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1555 CALL get_qs_env(qs_env=qs_env, rho_xc=rho_xc)
1559 IF (dft_control%do_admm)
THEN
1561 xc_section => admm_env%xc_section_primary
1566 IF (use_virial)
THEN
1567 virial%pv_xc = 0.0_dp
1570 NULLIFY (v_xc, v_xc_tau)
1573 rho=rho_xc, rho1_r=rhoz_r_xc, rho1_g=rhoz_g_xc, tau1_r=tauz_r_xc, &
1574 xc_section=xc_section, compute_virial=use_virial, virial_xc=virial%pv_xc)
1577 rho=rho, rho1_r=rhoz_r, rho1_g=rhoz_g, tau1_r=tauz_r, &
1578 xc_section=xc_section, compute_virial=use_virial, virial_xc=virial%pv_xc)
1581 IF (gapw .OR. gapw_xc)
THEN
1583 NULLIFY (local_rho_set_t)
1586 qs_kind_set, dft_control, para_env)
1587 CALL init_rho0(local_rho_set_t, qs_env, dft_control%qs_control%gapw_control, &
1591 qs_kind_set, oce, sab_orb, para_env)
1593 NULLIFY (local_rho_set_gs)
1596 qs_kind_set, dft_control, para_env)
1597 CALL init_rho0(local_rho_set_gs, qs_env, dft_control%qs_control%gapw_control)
1600 qs_kind_set, oce, sab_orb, para_env)
1603 ALLOCATE (rho_r_t(nspins), rho_g_t(nspins))
1604 DO ispin = 1, nspins
1605 CALL auxbas_pw_pool%create_pw(rho_r_t(ispin))
1606 CALL auxbas_pw_pool%create_pw(rho_g_t(ispin))
1608 CALL auxbas_pw_pool%create_pw(rho_tot_gspace_t)
1609 total_rho_t = 0.0_dp
1610 CALL pw_zero(rho_tot_gspace_t)
1611 DO ispin = 1, nspins
1613 rho=rho_r_t(ispin), &
1614 rho_gspace=rho_g_t(ispin), &
1616 total_rho=total_rho_t(ispin))
1617 CALL pw_axpy(rho_g_t(ispin), rho_tot_gspace_t)
1621 CALL pw_axpy(local_rho_set_t%rho0_mpole%rho0_s_gs, rho_tot_gspace_t)
1622 IF (
ASSOCIATED(local_rho_set_t%rho0_mpole%rhoz_cneo_s_gs))
THEN
1623 CALL pw_axpy(local_rho_set_t%rho0_mpole%rhoz_cneo_s_gs, rho_tot_gspace_t)
1626 CALL auxbas_pw_pool%create_pw(v_hartree_gspace_t)
1627 CALL auxbas_pw_pool%create_pw(v_hartree_rspace_t)
1628 NULLIFY (hartree_local_t)
1631 CALL pw_poisson_solve(poisson_env, rho_tot_gspace_t, hartree_t, v_hartree_gspace_t)
1632 CALL pw_transfer(v_hartree_gspace_t, v_hartree_rspace_t)
1633 CALL pw_scale(v_hartree_rspace_t, v_hartree_rspace_t%pw_grid%dvol)
1635 IF (debug_forces) fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1)
1636 CALL vh_1c_gg_integrals(qs_env, hartree_t, hartree_local_t%ecoul_1c, local_rho_set_gs, para_env, tddft=.false., &
1637 local_rho_set_2nd=local_rho_set_t, core_2nd=.true.)
1639 local_rho_set=local_rho_set_gs, local_rho_set_2nd=local_rho_set_t)
1640 IF (debug_forces)
THEN
1641 fodeb(1:3) = force(1)%g0s_Vh_elec(1:3, 1) - fodeb(1:3)
1642 CALL para_env%sum(fodeb)
1643 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Vh(T)*dncore PAWg0", fodeb
1648 IF (gapw .OR. gapw_xc)
THEN
1652 NULLIFY (local_rho_set_f)
1655 qs_kind_set, dft_control, para_env)
1657 qs_kind_set, oce, sab_orb, para_env)
1661 local_rho_set_f%rho_atom_set, &
1662 qs_env, xc_section, para_env, &
1668 IF (use_virial)
THEN
1669 virial%pv_exc = virial%pv_exc + virial%pv_xc
1670 virial%pv_virial = virial%pv_virial + virial%pv_xc
1673 IF (debug_stress .AND. use_virial)
THEN
1674 stdeb = 1.0_dp*fconv*virial%pv_xc
1675 CALL para_env%sum(stdeb)
1676 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1681 IF (use_virial)
THEN
1682 pv_loc = virial%pv_virial
1687 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1689 DO ispin = 1, nspins
1690 CALL pw_scale(v_xc(ispin), v_xc(ispin)%pw_grid%dvol)
1692 IF ((.NOT. (gapw)) .AND. (.NOT. gapw_xc))
THEN
1693 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1694 DO ispin = 1, nspins
1695 CALL pw_axpy(zv_hartree_rspace, v_xc(ispin))
1696 CALL integrate_v_rspace(qs_env=qs_env, &
1697 v_rspace=v_xc(ispin), &
1698 hmat=matrix_hz(ispin), &
1699 pmat=matrix_p(ispin, 1), &
1701 calculate_forces=.true.)
1703 IF (debug_forces)
THEN
1704 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1705 CALL para_env%sum(fodeb)
1706 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dKhxc*rhoz ", fodeb
1709 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1711 DO ispin = 1, nspins
1712 CALL integrate_v_rspace(qs_env=qs_env, &
1713 v_rspace=v_xc(ispin), &
1714 hmat=matrix_hz(ispin), &
1715 pmat=matrix_p(ispin, 1), &
1717 calculate_forces=.true.)
1721 DO ispin = 1, nspins
1724 CALL pw_axpy(v_hartree_rspace_t, v_xc(ispin))
1725 ELSEIF (gapw_xc)
THEN
1726 CALL pw_axpy(zv_hartree_rspace, v_xc(ispin))
1728 CALL integrate_v_rspace(qs_env=qs_env, &
1729 v_rspace=v_xc(ispin), &
1730 hmat=matrix_ht(ispin), &
1731 pmat=matrix_p(ispin, 1), &
1733 calculate_forces=.true.)
1735 IF (debug_forces)
THEN
1736 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1737 CALL para_env%sum(fodeb)
1738 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dKhxc*rhoz ", fodeb
1742 IF (gapw .OR. gapw_xc)
THEN
1745 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
1746 CALL update_ks_atom(qs_env, matrix_hz, matrix_p, forces=.true., tddft=.false., &
1747 rho_atom_external=local_rho_set_f%rho_atom_set)
1748 IF (debug_forces)
THEN
1749 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
1750 CALL para_env%sum(fodeb)
1751 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P^GS*dKxc*(Dz+T) PAW", fodeb
1756 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
1757 CALL update_ks_atom(qs_env, matrix_ht, matrix_p, forces=.true., tddft=.false., &
1758 rho_atom_external=local_rho_set_t%rho_atom_set)
1759 IF (debug_forces)
THEN
1760 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
1761 CALL para_env%sum(fodeb)
1762 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: P^GS*dKh*(Dz+T) PAW", fodeb
1766 DO ispin = 1, nspins
1767 CALL dbcsr_add(matrix_hz(ispin)%matrix, matrix_ht(ispin)%matrix, 1.0_dp, 1.0_dp)
1778 CALL auxbas_pw_pool%give_back_pw(v_hartree_gspace_t)
1779 CALL auxbas_pw_pool%give_back_pw(v_hartree_rspace_t)
1781 CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace_t)
1782 DO ispin = 1, nspins
1783 CALL auxbas_pw_pool%give_back_pw(rho_r_t(ispin))
1784 CALL auxbas_pw_pool%give_back_pw(rho_g_t(ispin))
1786 DEALLOCATE (rho_r_t, rho_g_t)
1789 IF (debug_stress .AND. use_virial)
THEN
1790 stdeb = fconv*(virial%pv_virial - stdeb)
1791 CALL para_env%sum(stdeb)
1792 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1796 IF (
ASSOCIATED(v_xc_tau))
THEN
1797 cpassert(.NOT. (gapw .OR. gapw_xc))
1798 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1799 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1800 DO ispin = 1, nspins
1801 CALL pw_scale(v_xc_tau(ispin), v_xc_tau(ispin)%pw_grid%dvol)
1802 CALL integrate_v_rspace(qs_env=qs_env, &
1803 v_rspace=v_xc_tau(ispin), &
1804 hmat=matrix_hz(ispin), &
1805 pmat=matrix_p(ispin, 1), &
1806 compute_tau=.true., &
1807 gapw=(gapw .OR. gapw_xc), &
1808 calculate_forces=.true.)
1810 IF (debug_forces)
THEN
1811 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1812 CALL para_env%sum(fodeb)
1813 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dKtau*tauz ", fodeb
1816 IF (debug_stress .AND. use_virial)
THEN
1817 stdeb = fconv*(virial%pv_virial - stdeb)
1818 CALL para_env%sum(stdeb)
1819 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1823 IF (use_virial)
THEN
1824 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
1829 IF (dft_control%qs_control%do_kg)
THEN
1832 IF (use_virial)
THEN
1833 pv_loc = virial%pv_virial
1836 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1837 IF (use_virial) virial%pv_xc = 0.0_dp
1839 ks_matrix=matrix_hz, &
1840 ekin_mol=ekin_mol, &
1841 calc_force=.true., &
1845 IF (debug_forces)
THEN
1846 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1847 CALL para_env%sum(fodeb)
1848 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*d(Kkg)*rhoz ", fodeb
1850 IF (debug_stress .AND. use_virial)
THEN
1851 stdeb = fconv*(virial%pv_virial - pv_loc)
1852 CALL para_env%sum(stdeb)
1853 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1856 stdeb = fconv*(virial%pv_xc)
1857 CALL para_env%sum(stdeb)
1858 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1863 IF (use_virial)
THEN
1865 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
1868 virial%pv_exc = virial%pv_exc - virial%pv_xc
1869 virial%pv_virial = virial%pv_virial - virial%pv_xc
1870 virial%pv_xc = 0.0_dp
1874 CALL auxbas_pw_pool%give_back_pw(rhoz_tot_gspace)
1875 CALL auxbas_pw_pool%give_back_pw(zv_hartree_gspace)
1876 CALL auxbas_pw_pool%give_back_pw(zv_hartree_rspace)
1877 DO ispin = 1, nspins
1878 CALL auxbas_pw_pool%give_back_pw(rhoz_r(ispin))
1879 CALL auxbas_pw_pool%give_back_pw(rhoz_g(ispin))
1880 CALL auxbas_pw_pool%give_back_pw(v_xc(ispin))
1882 DEALLOCATE (rhoz_r, rhoz_g, v_xc)
1884 DO ispin = 1, nspins
1885 CALL auxbas_pw_pool%give_back_pw(rhoz_r_xc(ispin))
1886 CALL auxbas_pw_pool%give_back_pw(rhoz_g_xc(ispin))
1888 DEALLOCATE (rhoz_r_xc, rhoz_g_xc)
1890 IF (
ASSOCIATED(v_xc_tau))
THEN
1891 DO ispin = 1, nspins
1892 CALL auxbas_pw_pool%give_back_pw(tauz_r(ispin))
1893 CALL auxbas_pw_pool%give_back_pw(v_xc_tau(ispin))
1895 DEALLOCATE (tauz_r, v_xc_tau)
1897 IF (debug_forces)
THEN
1898 ALLOCATE (ftot3(3, natom))
1900 fodeb(1:3) = ftot3(1:3, 1) - ftot2(1:3, 1)
1901 CALL para_env%sum(fodeb)
1902 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*V(rhoz)", fodeb
1911 IF (dft_control%do_admm)
THEN
1913 exc_aux_fit = 0.0_dp
1917 NULLIFY (mpz, mhz, mhx, mhy)
1921 CALL get_admm_env(admm_env, rho_aux_fit=rho_aux_fit, matrix_s_aux_fit=scrm, &
1922 task_list_aux_fit=task_list_aux_fit)
1924 NULLIFY (mpz, mhz, mhx, mhy)
1928 DO ispin = 1, nspins
1929 ALLOCATE (mhx(ispin, 1)%matrix)
1930 CALL dbcsr_create(mhx(ispin, 1)%matrix, template=scrm(1)%matrix)
1931 CALL dbcsr_copy(mhx(ispin, 1)%matrix, scrm(1)%matrix)
1932 CALL dbcsr_set(mhx(ispin, 1)%matrix, 0.0_dp)
1933 ALLOCATE (mhy(ispin, 1)%matrix)
1934 CALL dbcsr_create(mhy(ispin, 1)%matrix, template=scrm(1)%matrix)
1935 CALL dbcsr_copy(mhy(ispin, 1)%matrix, scrm(1)%matrix)
1936 CALL dbcsr_set(mhy(ispin, 1)%matrix, 0.0_dp)
1937 ALLOCATE (mpz(ispin, 1)%matrix)
1939 CALL dbcsr_create(mpz(ispin, 1)%matrix, template=p_env%p1_admm(ispin)%matrix)
1940 CALL dbcsr_copy(mpz(ispin, 1)%matrix, p_env%p1_admm(ispin)%matrix)
1941 CALL dbcsr_add(mpz(ispin, 1)%matrix, ex_env%matrix_pe_admm(ispin)%matrix, &
1944 CALL dbcsr_create(mpz(ispin, 1)%matrix, template=matrix_pz_admm(ispin)%matrix)
1945 CALL dbcsr_copy(mpz(ispin, 1)%matrix, matrix_pz_admm(ispin)%matrix)
1949 xc_section => admm_env%xc_section_aux
1952 IF (use_virial)
THEN
1953 pv_loc = virial%pv_virial
1956 basis_type =
"AUX_FIT"
1957 task_list => task_list_aux_fit
1958 IF (admm_env%do_gapw)
THEN
1959 basis_type =
"AUX_FIT_SOFT"
1960 task_list => admm_env%admm_gapw_env%task_list
1963 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
1964 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
1965 DO ispin = 1, nspins
1966 CALL integrate_v_rspace(v_rspace=vadmm_rspace(ispin), &
1967 hmat=mhx(ispin, 1), pmat=mpz(ispin, 1), &
1968 qs_env=qs_env, calculate_forces=.true., &
1969 basis_type=basis_type, task_list_external=task_list)
1971 IF (debug_forces)
THEN
1972 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
1973 CALL para_env%sum(fodeb)
1974 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*Vxc(rho_admm)", fodeb
1976 IF (debug_stress .AND. use_virial)
THEN
1977 stdeb = fconv*(virial%pv_virial - pv_loc)
1978 CALL para_env%sum(stdeb)
1979 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
1983 IF (use_virial)
THEN
1984 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
1987 IF (admm_env%do_gapw)
THEN
1989 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
1990 CALL update_ks_atom(qs_env, mhx(:, 1), mpz(:, 1), forces=.true., tddft=.false., &
1991 rho_atom_external=admm_env%admm_gapw_env%local_rho_set%rho_atom_set, &
1992 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
1993 oce_external=admm_env%admm_gapw_env%oce, &
1994 sab_external=sab_aux_fit)
1995 IF (debug_forces)
THEN
1996 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
1997 CALL para_env%sum(fodeb)
1998 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*Vxc(rho_admm)PAW", fodeb
2002 NULLIFY (rho_g_aux, rho_r_aux, tau_r_aux)
2003 CALL qs_rho_get(rho_aux_fit, rho_r=rho_r_aux, rho_g=rho_g_aux, tau_r=tau_r_aux)
2005 NULLIFY (rhoz_g_aux, rhoz_r_aux)
2006 ALLOCATE (rhoz_r_aux(nspins), rhoz_g_aux(nspins))
2007 DO ispin = 1, nspins
2008 CALL auxbas_pw_pool%create_pw(rhoz_r_aux(ispin))
2009 CALL auxbas_pw_pool%create_pw(rhoz_g_aux(ispin))
2011 DO ispin = 1, nspins
2013 rho=rhoz_r_aux(ispin), rho_gspace=rhoz_g_aux(ispin), &
2014 basis_type=basis_type, task_list_external=task_list)
2018 IF (use_virial)
THEN
2022 DO ispin = 1, nspins
2023 exc_aux_fit = exc_aux_fit +
pw_integral_ab(rhoz_r_aux(ispin), vadmm_rspace(ispin))/ &
2024 vadmm_rspace(ispin)%pw_grid%dvol
2027 IF (debug_stress)
THEN
2028 stdeb = -1.0_dp*fconv*exc_aux_fit
2029 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T43,2(1X,ES19.11))") &
2037 IF (use_virial) virial%pv_xc = 0.0_dp
2043 rho1_r=rhoz_r_aux, &
2044 rho1_g=rhoz_g_aux, &
2046 xc_section=xc_section, &
2047 compute_virial=use_virial, &
2048 virial_xc=virial%pv_xc)
2051 IF (use_virial)
THEN
2052 virial%pv_exc = virial%pv_exc + virial%pv_xc
2053 virial%pv_virial = virial%pv_virial + virial%pv_xc
2056 IF (debug_stress .AND. use_virial)
THEN
2057 stdeb = 1.0_dp*fconv*virial%pv_xc
2058 CALL para_env%sum(stdeb)
2059 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2063 CALL qs_rho_get(rho_aux_fit, rho_ao_kp=matrix_p)
2065 IF (use_virial)
THEN
2066 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
2068 IF (debug_forces) fodeb(1:3) = force(1)%rho_elec(1:3, 1)
2069 IF (debug_stress .AND. use_virial) stdeb = virial%pv_virial
2070 DO ispin = 1, nspins
2071 CALL dbcsr_set(mhy(ispin, 1)%matrix, 0.0_dp)
2072 CALL pw_scale(v_xc(ispin), v_xc(ispin)%pw_grid%dvol)
2073 CALL integrate_v_rspace(qs_env=qs_env, v_rspace=v_xc(ispin), &
2074 hmat=mhy(ispin, 1), pmat=matrix_p(ispin, 1), &
2075 calculate_forces=.true., &
2076 basis_type=basis_type, task_list_external=task_list)
2078 IF (debug_forces)
THEN
2079 fodeb(1:3) = force(1)%rho_elec(1:3, 1) - fodeb(1:3)
2080 CALL para_env%sum(fodeb)
2081 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dK*rhoz_admm ", fodeb
2083 IF (debug_stress .AND. use_virial)
THEN
2084 stdeb = fconv*(virial%pv_virial - pv_loc)
2085 CALL para_env%sum(stdeb)
2086 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2090 IF (use_virial)
THEN
2091 virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
2093 DO ispin = 1, nspins
2094 CALL auxbas_pw_pool%give_back_pw(v_xc(ispin))
2095 CALL auxbas_pw_pool%give_back_pw(rhoz_r_aux(ispin))
2096 CALL auxbas_pw_pool%give_back_pw(rhoz_g_aux(ispin))
2098 DEALLOCATE (v_xc, rhoz_r_aux, rhoz_g_aux)
2100 IF (admm_env%do_gapw)
THEN
2103 admm_env%admm_gapw_env%admm_kind_set, dft_control, para_env)
2105 admm_env%admm_gapw_env%admm_kind_set, &
2106 admm_env%admm_gapw_env%oce, sab_aux_fit, para_env)
2108 do_rho0=.false., kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
2111 local_rhoz_set_admm%rho_atom_set, &
2112 qs_env, xc_section, para_env, do_triplet=.false., &
2113 kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
2115 IF (debug_forces) fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1)
2116 CALL update_ks_atom(qs_env, mhy(:, 1), matrix_p(:, 1), forces=.true., tddft=.false., &
2117 rho_atom_external=local_rhoz_set_admm%rho_atom_set, &
2118 kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
2119 oce_external=admm_env%admm_gapw_env%oce, &
2120 sab_external=sab_aux_fit)
2121 IF (debug_forces)
THEN
2122 fodeb(1:3) = force(1)%Vhxc_atom(1:3, 1) - fodeb(1:3)
2123 CALL para_env%sum(fodeb)
2124 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pin*dK*rhoz_admm[PAW] ", fodeb
2129 nao = admm_env%nao_orb
2130 nao_aux = admm_env%nao_aux_fit
2132 CALL dbcsr_create(dbwork, template=matrix_hz(1)%matrix)
2133 DO ispin = 1, nspins
2135 admm_env%work_aux_orb, nao)
2137 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
2138 admm_env%work_orb_orb)
2139 CALL dbcsr_copy(dbwork, matrix_hz(ispin)%matrix)
2142 CALL dbcsr_add(matrix_hz(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
2159 cpassert(n_rep_hf == 1)
2163 IF (hfx_treat_lsd_in_core) mspin = nspins
2164 IF (use_virial) virial%pv_fock_4c = 0.0_dp
2166 CALL get_qs_env(qs_env=qs_env, rho=rho, x_data=x_data, &
2167 s_mstruct_changed=s_mstruct_changed)
2168 distribute_fock_matrix = .true.
2173 IF (dft_control%do_admm)
THEN
2174 CALL get_qs_env(qs_env=qs_env, admm_env=admm_env)
2175 CALL get_admm_env(admm_env, matrix_s_aux_fit=scrm, rho_aux_fit=rho_aux_fit)
2176 CALL qs_rho_get(rho_aux_fit, rho_ao_kp=matrix_p)
2177 NULLIFY (mpz, mhz, mpd, mhd)
2182 DO ispin = 1, nspins
2183 ALLOCATE (mhz(ispin, 1)%matrix, mhd(ispin, 1)%matrix)
2184 CALL dbcsr_create(mhz(ispin, 1)%matrix, template=scrm(1)%matrix)
2185 CALL dbcsr_create(mhd(ispin, 1)%matrix, template=scrm(1)%matrix)
2186 CALL dbcsr_copy(mhz(ispin, 1)%matrix, scrm(1)%matrix)
2187 CALL dbcsr_copy(mhd(ispin, 1)%matrix, scrm(1)%matrix)
2188 CALL dbcsr_set(mhz(ispin, 1)%matrix, 0.0_dp)
2189 CALL dbcsr_set(mhd(ispin, 1)%matrix, 0.0_dp)
2190 ALLOCATE (mpz(ispin, 1)%matrix)
2192 CALL dbcsr_create(mpz(ispin, 1)%matrix, template=scrm(1)%matrix)
2193 CALL dbcsr_copy(mpz(ispin, 1)%matrix, p_env%p1_admm(ispin)%matrix)
2194 CALL dbcsr_add(mpz(ispin, 1)%matrix, ex_env%matrix_pe_admm(ispin)%matrix, &
2197 CALL dbcsr_create(mpz(ispin, 1)%matrix, template=scrm(1)%matrix)
2198 CALL dbcsr_copy(mpz(ispin, 1)%matrix, matrix_pz_admm(ispin)%matrix)
2200 mpd(ispin, 1)%matrix => matrix_p(ispin, 1)%matrix
2203 IF (x_data(1, 1)%do_hfx_ri)
THEN
2206 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhz, eh1, rho_ao=mpz, &
2207 geometry_did_change=s_mstruct_changed, nspins=nspins, &
2208 hf_fraction=x_data(1, 1)%general_parameter%fraction)
2211 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhd, eh1, rho_ao=mpd, &
2212 geometry_did_change=s_mstruct_changed, nspins=nspins, &
2213 hf_fraction=x_data(1, 1)%general_parameter%fraction)
2219 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
2225 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
2231 cpassert(
ASSOCIATED(admm_env%work_aux_orb))
2232 cpassert(
ASSOCIATED(admm_env%work_orb_orb))
2233 nao = admm_env%nao_orb
2234 nao_aux = admm_env%nao_aux_fit
2236 CALL dbcsr_create(dbwork, template=matrix_hz(1)%matrix)
2237 DO ispin = 1, nspins
2239 admm_env%work_aux_orb, nao)
2241 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
2242 admm_env%work_orb_orb)
2243 CALL dbcsr_copy(dbwork, matrix_hz(ispin)%matrix)
2246 CALL dbcsr_add(matrix_hz(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
2251 IF (debug_forces) fodeb(1:3) = force(1)%overlap_admm(1:3, 1)
2252 IF (
ASSOCIATED(mhx) .AND.
ASSOCIATED(mhy))
THEN
2253 DO ispin = 1, nspins
2254 CALL dbcsr_add(mhd(ispin, 1)%matrix, mhx(ispin, 1)%matrix, 1.0_dp, 1.0_dp)
2255 CALL dbcsr_add(mhz(ispin, 1)%matrix, mhy(ispin, 1)%matrix, 1.0_dp, 1.0_dp)
2261 IF (debug_forces)
THEN
2262 fodeb(1:3) = force(1)%overlap_admm(1:3, 1) - fodeb(1:3)
2263 CALL para_env%sum(fodeb)
2264 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*hfx*S' ", fodeb
2269 IF (
ASSOCIATED(mhx) .AND.
ASSOCIATED(mhy))
THEN
2278 ALLOCATE (mpz(nspins, 1), mhz(nspins, 1))
2279 DO ispin = 1, nspins
2280 mhz(ispin, 1)%matrix => matrix_hz(ispin)%matrix
2281 mpz(ispin, 1)%matrix => mpa(ispin)%matrix
2284 IF (x_data(1, 1)%do_hfx_ri)
THEN
2287 CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhz, eh1, rho_ao=mpz, &
2288 geometry_did_change=s_mstruct_changed, nspins=nspins, &
2289 hf_fraction=x_data(1, 1)%general_parameter%fraction)
2294 para_env, s_mstruct_changed, 1, distribute_fock_matrix, &
2298 DEALLOCATE (mhz, mpz)
2306 IF (debug_forces) fodeb(1:3) = force(1)%fock_4c(1:3, 1)
2307 IF (dft_control%do_admm)
THEN
2311 CALL qs_rho_get(rho_aux_fit, rho_ao_kp=matrix_p)
2312 NULLIFY (matrix_pza)
2314 DO ispin = 1, nspins
2315 ALLOCATE (matrix_pza(ispin)%matrix)
2317 CALL dbcsr_create(matrix_pza(ispin)%matrix, template=p_env%p1_admm(ispin)%matrix)
2318 CALL dbcsr_copy(matrix_pza(ispin)%matrix, p_env%p1_admm(ispin)%matrix)
2319 CALL dbcsr_add(matrix_pza(ispin)%matrix, ex_env%matrix_pe_admm(ispin)%matrix, &
2322 CALL dbcsr_create(matrix_pza(ispin)%matrix, template=matrix_pz_admm(ispin)%matrix)
2323 CALL dbcsr_copy(matrix_pza(ispin)%matrix, matrix_pz_admm(ispin)%matrix)
2326 IF (x_data(1, 1)%do_hfx_ri)
THEN
2329 x_data(1, 1)%general_parameter%fraction, &
2330 rho_ao=matrix_p, rho_ao_resp=matrix_pza, &
2331 use_virial=use_virial, resp_only=resp_only)
2334 1, use_virial, resp_only=resp_only)
2342 IF (x_data(1, 1)%do_hfx_ri)
THEN
2345 x_data(1, 1)%general_parameter%fraction, &
2346 rho_ao=matrix_p, rho_ao_resp=mpa, &
2347 use_virial=use_virial, resp_only=resp_only)
2350 1, use_virial, resp_only=resp_only)
2354 IF (use_virial)
THEN
2355 virial%pv_exx = virial%pv_exx - virial%pv_fock_4c
2356 virial%pv_virial = virial%pv_virial - virial%pv_fock_4c
2357 virial%pv_calculate = .false.
2360 IF (debug_forces)
THEN
2361 fodeb(1:3) = force(1)%fock_4c(1:3, 1) - fodeb(1:3)
2362 CALL para_env%sum(fodeb)
2363 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Pz*hfx ", fodeb
2365 IF (debug_stress .AND. use_virial)
THEN
2366 stdeb = -1.0_dp*fconv*virial%pv_fock_4c
2367 CALL para_env%sum(stdeb)
2368 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2375 IF (use_virial)
THEN
2377 zehartree = zehartree + 2.0_dp*ehartree
2380 IF (dft_control%do_admm)
THEN
2381 zexc_aux_fit = zexc_aux_fit + exc_aux_fit
2388 IF (dft_control%qs_control%do_ls_scf)
THEN
2390 eps_filter = dft_control%qs_control%eps_filter_matrix
2391 CALL calculate_whz_ao_matrix(qs_env, matrix_hz, matrix_wz, eps_filter)
2394 matrix_wz => p_env%w1
2397 IF (nspins == 1) focc = 2.0_dp
2399 DO ispin = 1, nspins
2400 CALL get_mo_set(mo_set=mos(ispin), homo=nocc)
2402 matrix_wz(ispin)%matrix, focc, nocc)
2405 IF (nspins == 2)
THEN
2406 CALL dbcsr_add(matrix_wz(1)%matrix, matrix_wz(2)%matrix, &
2407 alpha_scalar=1.0_dp, beta_scalar=1.0_dp)
2410 IF (debug_forces) fodeb(1:3) = force(1)%overlap(1:3, 1)
2411 IF (debug_stress .AND. use_virial) stdeb = virial%pv_overlap
2414 matrix_name=
"OVERLAP MATRIX", &
2415 basis_type_a=
"ORB", basis_type_b=
"ORB", &
2416 sab_nl=sab_orb, calculate_forces=.true., &
2417 matrix_p=matrix_wz(1)%matrix)
2419 IF (
SIZE(matrix_wz, 1) == 2)
THEN
2420 CALL dbcsr_add(matrix_wz(1)%matrix, matrix_wz(2)%matrix, &
2421 alpha_scalar=1.0_dp, beta_scalar=-1.0_dp)
2424 IF (debug_forces)
THEN
2425 fodeb(1:3) = force(1)%overlap(1:3, 1) - fodeb(1:3)
2426 CALL para_env%sum(fodeb)
2427 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Wz*dS ", fodeb
2429 IF (debug_stress .AND. use_virial)
THEN
2430 stdeb = fconv*(virial%pv_overlap - stdeb)
2431 CALL para_env%sum(stdeb)
2432 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2437 IF (debug_forces)
THEN
2439 fodeb(1:3) = ftot2(1:3, 1) - ftot1(1:3, 1)
2440 CALL para_env%sum(fodeb)
2441 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Response Force", fodeb
2442 fodeb(1:3) = ftot2(1:3, 1)
2443 CALL para_env%sum(fodeb)
2444 IF (iounit > 0)
WRITE (iounit,
"(T3,A,T33,3F16.8)")
"DEBUG:: Total Force ", fodeb
2445 DEALLOCATE (ftot1, ftot2, ftot3)
2447 IF (debug_stress .AND. use_virial)
THEN
2448 stdeb = fconv*(virial%pv_virial - sttot)
2449 CALL para_env%sum(stdeb)
2450 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2452 stdeb = fconv*(virial%pv_virial)
2453 CALL para_env%sum(stdeb)
2454 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,A,T41,2(1X,ES19.11))") &
2456 IF (iounit > 0)
WRITE (unit=iounit, fmt=
"(T2,3(1X,ES19.11))") &
2457 stdeb(1, 1), stdeb(2, 2), stdeb(3, 3)
2466 CALL timestop(handle)