mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-30 15:15:38 +01:00
Merge pull request #302 from AbdAmmar/dev-stable-tc-scf
Some checks failed
continuous-integration/drone/push Build is failing
Some checks failed
continuous-integration/drone/push Build is failing
Dev stable tc scf
This commit is contained in:
AbdAmmar
GitHub
commit
67a83f767b
@ -212,9 +212,7 @@ subroutine NAI_pol_x_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
|
||||
! Computes the following integral :
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr x * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr y * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr z * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
@ -279,9 +277,7 @@ subroutine NAI_pol_x_mult_erf_ao_v0(i_ao, j_ao, mu_in, C_center, LD_C, ints, LD_
|
||||
! Computes the following integral :
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr x * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr y * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr z * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
@ -1111,3 +1107,141 @@ end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine NAI_pol_x2_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center, ints)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr x^2 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! $\int_{-\infty}^{infty} dr y^2 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! $\int_{-\infty}^{infty} dr z^2 * \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_ao, j_ao
|
||||
double precision, intent(in) :: beta, B_center(3), mu_in, C_center(3)
|
||||
double precision, intent(out) :: ints(3)
|
||||
|
||||
integer :: i, j, power_Ai(3), power_Aj(3), n_pt_in, m
|
||||
integer :: power_A1(3), power_A2(3)
|
||||
double precision :: Ai_center(3), Aj_center(3), alphai, alphaj, coef, coefi
|
||||
double precision :: integral0, integral1, integral2
|
||||
|
||||
double precision, external :: NAI_pol_mult_erf_with1s
|
||||
|
||||
ASSERT(beta .ge. 0.d0)
|
||||
if(beta .lt. 1d-10) then
|
||||
call NAI_pol_x2_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
|
||||
return
|
||||
endif
|
||||
|
||||
ints = 0.d0
|
||||
|
||||
power_Ai(1:3) = ao_power(i_ao,1:3)
|
||||
power_Aj(1:3) = ao_power(j_ao,1:3)
|
||||
|
||||
Ai_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
|
||||
Aj_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
|
||||
do i = 1, ao_prim_num(i_ao)
|
||||
alphai = ao_expo_ordered_transp (i,i_ao)
|
||||
coefi = ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
|
||||
do m = 1, 3
|
||||
|
||||
power_A1 = power_Ai
|
||||
power_A1(m) += 1
|
||||
|
||||
power_A2 = power_Ai
|
||||
power_A2(m) += 2
|
||||
|
||||
do j = 1, ao_prim_num(j_ao)
|
||||
alphaj = ao_expo_ordered_transp (j,j_ao)
|
||||
coef = coefi * ao_coef_normalized_ordered_transp(j,j_ao)
|
||||
|
||||
integral0 = NAI_pol_mult_erf_with1s(Ai_center, Aj_center, power_Ai, power_Aj, alphai, alphaj, beta, B_center, C_center, n_pt_in, mu_in)
|
||||
integral1 = NAI_pol_mult_erf_with1s(Ai_center, Aj_center, power_A1, power_Aj, alphai, alphaj, beta, B_center, C_center, n_pt_in, mu_in)
|
||||
integral2 = NAI_pol_mult_erf_with1s(Ai_center, Aj_center, power_A2, power_Aj, alphai, alphaj, beta, B_center, C_center, n_pt_in, mu_in)
|
||||
|
||||
ints(m) += coef * (integral2 + Ai_center(m) * (2.d0*integral1 + Ai_center(m)*integral0))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine NAI_pol_x2_mult_erf_ao_with1s
|
||||
|
||||
! ---
|
||||
|
||||
subroutine NAI_pol_x2_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! Computes the following integral :
|
||||
!
|
||||
! $\int_{-\infty}^{infty} dr x^2 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! $\int_{-\infty}^{infty} dr y^2 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
! $\int_{-\infty}^{infty} dr z^2 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'utils/constants.include.F'
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_ao, j_ao
|
||||
double precision, intent(in) :: mu_in, C_center(3)
|
||||
double precision, intent(out) :: ints(3)
|
||||
|
||||
integer :: i, j, num_A, num_B, power_A(3), power_B(3), n_pt_in, m
|
||||
integer :: power_A1(3), power_A2(3)
|
||||
double precision :: A_center(3), B_center(3), alpha, beta, coef
|
||||
double precision :: integral0, integral1, integral2
|
||||
|
||||
double precision :: NAI_pol_mult_erf
|
||||
|
||||
ints = 0.d0
|
||||
|
||||
num_A = ao_nucl(i_ao)
|
||||
power_A(1:3) = ao_power(i_ao,1:3)
|
||||
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||
num_B = ao_nucl(j_ao)
|
||||
power_B(1:3) = ao_power(j_ao,1:3)
|
||||
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||
|
||||
n_pt_in = n_pt_max_integrals
|
||||
|
||||
do i = 1, ao_prim_num(i_ao)
|
||||
alpha = ao_expo_ordered_transp(i,i_ao)
|
||||
|
||||
do m = 1, 3
|
||||
|
||||
power_A1 = power_A
|
||||
power_A1(m) += 1
|
||||
|
||||
power_A2 = power_A
|
||||
power_A2(m) += 2
|
||||
|
||||
do j = 1, ao_prim_num(j_ao)
|
||||
beta = ao_expo_ordered_transp(j,j_ao)
|
||||
coef = ao_coef_normalized_ordered_transp(j,j_ao) * ao_coef_normalized_ordered_transp(i,i_ao)
|
||||
|
||||
integral0 = NAI_pol_mult_erf(A_center, B_center, power_A , power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
integral1 = NAI_pol_mult_erf(A_center, B_center, power_A1, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
integral2 = NAI_pol_mult_erf(A_center, B_center, power_A2, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||
|
||||
ints(m) += coef * (integral2 + A_center(m) * (2.d0*integral1 + A_center(m)*integral0))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine NAI_pol_x2_mult_erf_ao
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
@ -128,6 +128,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n
|
||||
do i_1s = 2, List_all_comb_b3_size
|
||||
|
||||
coef = List_all_comb_b3_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b3_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b3_cent(2,i_1s)
|
||||
@ -222,6 +223,7 @@ BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_
|
||||
do i_1s = 2, List_all_comb_b3_size
|
||||
|
||||
coef = List_all_comb_b3_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b3_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b3_cent(2,i_1s)
|
||||
@ -322,6 +324,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin
|
||||
do i_1s = 2, List_all_comb_b3_size
|
||||
|
||||
coef = List_all_comb_b3_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b3_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b3_cent(2,i_1s)
|
||||
@ -436,6 +439,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points
|
||||
do i_1s = 2, List_all_comb_b3_size
|
||||
|
||||
coef = List_all_comb_b3_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b3_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b3_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b3_cent(2,i_1s)
|
||||
|
||||
@ -60,6 +60,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po
|
||||
do i_1s = 2, List_all_comb_b2_size
|
||||
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b2_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b2_cent(2,i_1s)
|
||||
@ -154,6 +155,7 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_
|
||||
do i_1s = 2, List_all_comb_b2_size
|
||||
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b2_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b2_cent(2,i_1s)
|
||||
@ -195,8 +197,7 @@ END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
! TODO analytically
|
||||
BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid)]
|
||||
BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_points_final_grid)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
@ -213,12 +214,14 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
|
||||
double precision, external :: overlap_gauss_r12_ao_with1s
|
||||
|
||||
print*, ' providing v_ij_u_cst_mu_j1b ...'
|
||||
print*, ' providing v_ij_u_cst_mu_j1b_fit ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mu_erf final_grid_points j1b_pen
|
||||
PROVIDE ng_fit_jast expo_gauss_j_mu_x coef_gauss_j_mu_x
|
||||
PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent
|
||||
|
||||
v_ij_u_cst_mu_j1b = 0.d0
|
||||
v_ij_u_cst_mu_j1b_fit = 0.d0
|
||||
|
||||
!$OMP PARALLEL DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, &
|
||||
@ -227,9 +230,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
!$OMP final_grid_points, ng_fit_jast, &
|
||||
!$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, &
|
||||
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, &
|
||||
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b)
|
||||
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_fit)
|
||||
!$OMP DO
|
||||
!do ipoint = 1, 10
|
||||
do ipoint = 1, n_points_final_grid
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
r(2) = final_grid_points(2,ipoint)
|
||||
@ -240,7 +242,6 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
|
||||
tmp = 0.d0
|
||||
do i_fit = 1, ng_fit_jast
|
||||
|
||||
expo_fit = expo_gauss_j_mu_x(i_fit)
|
||||
coef_fit = coef_gauss_j_mu_x(i_fit)
|
||||
|
||||
@ -253,7 +254,6 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
B_center(3) = List_all_comb_b2_cent(3,1)
|
||||
|
||||
int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j)
|
||||
! if(dabs(int_fit*coef) .lt. 1d-12) cycle
|
||||
|
||||
tmp += coef * coef_fit * int_fit
|
||||
|
||||
@ -262,6 +262,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
do i_1s = 2, List_all_comb_b2_size
|
||||
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b2_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b2_cent(2,i_1s)
|
||||
@ -276,7 +277,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
|
||||
enddo
|
||||
|
||||
v_ij_u_cst_mu_j1b(j,i,ipoint) = tmp
|
||||
v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = tmp
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
@ -286,13 +287,149 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b, (ao_num, ao_num, n_points_
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 2, ao_num
|
||||
do j = 1, i-1
|
||||
v_ij_u_cst_mu_j1b(j,i,ipoint) = v_ij_u_cst_mu_j1b(i,j,ipoint)
|
||||
v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = v_ij_u_cst_mu_j1b_fit(i,j,ipoint)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call wall_time(wall1)
|
||||
print*, ' wall time for v_ij_u_cst_mu_j1b', wall1 - wall0
|
||||
print*, ' wall time for v_ij_u_cst_mu_j1b_fit', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_points_final_grid)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12)
|
||||
!
|
||||
! TODO
|
||||
! one subroutine for all integrals
|
||||
!
|
||||
END_DOC
|
||||
|
||||
include 'constants.include.F'
|
||||
|
||||
implicit none
|
||||
integer :: i, j, ipoint, i_1s
|
||||
double precision :: r(3), r1_2
|
||||
double precision :: int_c1, int_e1, int_o
|
||||
double precision :: int_c2(3), int_e2(3)
|
||||
double precision :: int_c3(3), int_e3(3)
|
||||
double precision :: coef, beta, B_center(3)
|
||||
double precision :: tmp, ct
|
||||
double precision :: wall0, wall1
|
||||
|
||||
double precision, external :: overlap_gauss_r12_ao_with1s
|
||||
double precision, external :: NAI_pol_mult_erf_ao_with1s
|
||||
|
||||
print*, ' providing v_ij_u_cst_mu_j1b_an ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mu_erf final_grid_points j1b_pen
|
||||
PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent
|
||||
|
||||
ct = inv_sq_pi_2 / mu_erf
|
||||
|
||||
v_ij_u_cst_mu_j1b_an = 0.d0
|
||||
|
||||
!$OMP PARALLEL DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, &
|
||||
!$OMP r1_2, tmp, int_c1, int_e1, int_o, int_c2, &
|
||||
!$OMP int_e2, int_c3, int_e3) &
|
||||
!$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, &
|
||||
!$OMP final_grid_points, mu_erf, ct, &
|
||||
!$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, &
|
||||
!$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_an)
|
||||
!$OMP DO
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
r(1) = final_grid_points(1,ipoint)
|
||||
r(2) = final_grid_points(2,ipoint)
|
||||
r(3) = final_grid_points(3,ipoint)
|
||||
r1_2 = 0.5d0 * (r(1)*r(1) + r(2)*r(2) + r(3)*r(3))
|
||||
|
||||
do i = 1, ao_num
|
||||
do j = i, ao_num
|
||||
|
||||
! ---
|
||||
|
||||
coef = List_all_comb_b2_coef (1)
|
||||
beta = List_all_comb_b2_expo (1)
|
||||
B_center(1) = List_all_comb_b2_cent(1,1)
|
||||
B_center(2) = List_all_comb_b2_cent(2,1)
|
||||
B_center(3) = List_all_comb_b2_cent(3,1)
|
||||
|
||||
int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r)
|
||||
int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
|
||||
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c2)
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e2)
|
||||
|
||||
call NAI_pol_x2_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c3)
|
||||
call NAI_pol_x2_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e3)
|
||||
|
||||
int_o = overlap_gauss_r12_ao_with1s(B_center, beta, r, mu_erf*mu_erf, i, j)
|
||||
|
||||
tmp = coef &
|
||||
* ( r1_2 * (int_c1 - int_e1) &
|
||||
- r(1) * (int_c2(1) - int_e2(1)) - r(2) * (int_c2(2) - int_e2(2)) - r(3) * (int_c2(3) - int_e2(3)) &
|
||||
+ 0.5d0 * (int_c3(1) + int_c3(2) + int_c3(3) - int_e3(1) - int_e3(2) - int_e3(3)) &
|
||||
- ct * int_o &
|
||||
)
|
||||
|
||||
! ---
|
||||
|
||||
do i_1s = 2, List_all_comb_b2_size
|
||||
|
||||
coef = List_all_comb_b2_coef (i_1s)
|
||||
if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0
|
||||
beta = List_all_comb_b2_expo (i_1s)
|
||||
B_center(1) = List_all_comb_b2_cent(1,i_1s)
|
||||
B_center(2) = List_all_comb_b2_cent(2,i_1s)
|
||||
B_center(3) = List_all_comb_b2_cent(3,i_1s)
|
||||
|
||||
int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r)
|
||||
int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r)
|
||||
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c2)
|
||||
call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e2)
|
||||
|
||||
call NAI_pol_x2_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c3)
|
||||
call NAI_pol_x2_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e3)
|
||||
|
||||
int_o = overlap_gauss_r12_ao_with1s(B_center, beta, r, mu_erf*mu_erf, i, j)
|
||||
|
||||
tmp = tmp + coef &
|
||||
* ( r1_2 * (int_c1 - int_e1) &
|
||||
- r(1) * (int_c2(1) - int_e2(1)) - r(2) * (int_c2(2) - int_e2(2)) - r(3) * (int_c2(3) - int_e2(3)) &
|
||||
+ 0.5d0 * (int_c3(1) + int_c3(2) + int_c3(3) - int_e3(1) - int_e3(2) - int_e3(3)) &
|
||||
- ct * int_o &
|
||||
)
|
||||
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
v_ij_u_cst_mu_j1b_an(j,i,ipoint) = tmp
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 2, ao_num
|
||||
do j = 1, i-1
|
||||
v_ij_u_cst_mu_j1b_an(j,i,ipoint) = v_ij_u_cst_mu_j1b_an(i,j,ipoint)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call wall_time(wall1)
|
||||
print*, ' wall time for v_ij_u_cst_mu_j1b_an', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
@ -36,16 +36,25 @@ END_PROVIDER
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, expo_j_xmu, (n_fit_1_erf_x) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) is fitted with a gaussian and a Slater
|
||||
!
|
||||
! \approx - 1/sqrt(pi) * exp(-alpha * x ) exp(-beta * x**2)
|
||||
!
|
||||
! where alpha = expo_j_xmu(1) and beta = expo_j_xmu(2)
|
||||
END_DOC
|
||||
expo_j_xmu(1) = 1.7477d0
|
||||
expo_j_xmu(2) = 0.668662d0
|
||||
|
||||
BEGIN_DOC
|
||||
! F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) is fitted with a gaussian and a Slater
|
||||
!
|
||||
! \approx - 1/sqrt(pi) * exp(-alpha * x ) exp(-beta * x**2)
|
||||
!
|
||||
! where alpha = expo_j_xmu(1) and beta = expo_j_xmu(2)
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
!expo_j_xmu(1) = 1.7477d0
|
||||
!expo_j_xmu(2) = 0.668662d0
|
||||
|
||||
!expo_j_xmu(1) = 1.74766377595541d0
|
||||
!expo_j_xmu(2) = 0.668719925486403d0
|
||||
|
||||
expo_j_xmu(1) = 1.74770446934522d0
|
||||
expo_j_xmu(2) = 0.668659706559979d0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
@ -9,10 +9,9 @@ program bi_ort_ints
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
!my_n_pt_r_grid = 10
|
||||
!my_n_pt_a_grid = 14
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
! call test_3e
|
||||
|
||||
@ -140,8 +140,6 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_transp, (ao_num, ao_num, 3,
|
||||
enddo
|
||||
enddo
|
||||
|
||||
FREE int2_grad1_u12_ao
|
||||
|
||||
endif
|
||||
|
||||
call wall_time(wall1)
|
||||
@ -225,6 +223,8 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_t, (n_points_final_grid, 3,
|
||||
implicit none
|
||||
integer :: i, j, ipoint
|
||||
|
||||
PROVIDE int2_grad1_u12_ao
|
||||
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do i = 1, ao_num
|
||||
do j = 1, ao_num
|
||||
|
||||
@ -17,6 +17,8 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_direct_bi_ort, (mo_num, mo_num,
|
||||
integer :: i, j, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_3_idx_direct_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_3_idx_direct_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
@ -125,6 +127,8 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_2_bi_ort, (mo_num, mo_num
|
||||
integer :: i, j, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_3_idx_cycle_2_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_3_idx_cycle_2_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
@ -179,6 +183,8 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch23_bi_ort, (mo_num, mo_num,
|
||||
integer :: i, j, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_3_idx_exch23_bi_ort = 0.d0
|
||||
print*,'Providing the three_e_3_idx_exch23_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
@ -233,6 +239,8 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch13_bi_ort, (mo_num, mo_num,
|
||||
integer :: i,j,m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_3_idx_exch13_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_3_idx_exch13_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
@ -287,6 +295,8 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort, (mo_num, mo_num,
|
||||
integer :: i, j, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_3_idx_exch12_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_3_idx_exch12_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
@ -261,51 +261,55 @@ END_PROVIDER
|
||||
! ---
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj, (mo_num,mo_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_exchange, (mo_num,mo_num) ]
|
||||
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_anti, (mo_num,mo_num) ]
|
||||
implicit none
|
||||
BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj, (mo_num,mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_exchange, (mo_num,mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_anti, (mo_num,mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! mo_bi_ortho_tc_two_e_jj(i,j) = J_ij = <ji|W-K|ji>
|
||||
! mo_bi_ortho_tc_two_e_jj_exchange(i,j) = K_ij = <ij|W-K|ji>
|
||||
! mo_bi_ortho_tc_two_e_jj_anti(i,j) = J_ij - K_ij
|
||||
END_DOC
|
||||
|
||||
integer :: i,j
|
||||
double precision :: get_two_e_integral
|
||||
implicit none
|
||||
integer :: i, j
|
||||
|
||||
mo_bi_ortho_tc_two_e_jj = 0.d0
|
||||
mo_bi_ortho_tc_two_e_jj = 0.d0
|
||||
mo_bi_ortho_tc_two_e_jj_exchange = 0.d0
|
||||
|
||||
do i=1,mo_num
|
||||
do j=1,mo_num
|
||||
mo_bi_ortho_tc_two_e_jj(i,j) = mo_bi_ortho_tc_two_e(j,i,j,i)
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
mo_bi_ortho_tc_two_e_jj(i,j) = mo_bi_ortho_tc_two_e(j,i,j,i)
|
||||
mo_bi_ortho_tc_two_e_jj_exchange(i,j) = mo_bi_ortho_tc_two_e(i,j,j,i)
|
||||
mo_bi_ortho_tc_two_e_jj_anti(i,j) = mo_bi_ortho_tc_two_e_jj(i,j) - mo_bi_ortho_tc_two_e_jj_exchange(i,j)
|
||||
mo_bi_ortho_tc_two_e_jj_anti(i,j) = mo_bi_ortho_tc_two_e_jj(i,j) - mo_bi_ortho_tc_two_e_jj_exchange(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, tc_2e_3idx_coulomb_integrals, (mo_num,mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [double precision, tc_2e_3idx_exchange_integrals,(mo_num,mo_num, mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! tc_2e_3idx_coulomb_integrals(j,k,i) = <jk|ji>
|
||||
!
|
||||
! tc_2e_3idx_exchange_integrals(j,k,i) = <kj|ji>
|
||||
END_DOC
|
||||
integer :: i,j,k,l
|
||||
double precision :: get_two_e_integral
|
||||
double precision :: integral
|
||||
! ---
|
||||
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
tc_2e_3idx_coulomb_integrals(j, k,i) = mo_bi_ortho_tc_two_e(j ,k ,j ,i )
|
||||
tc_2e_3idx_exchange_integrals(j,k,i) = mo_bi_ortho_tc_two_e(k ,j ,j ,i )
|
||||
enddo
|
||||
BEGIN_PROVIDER [double precision, tc_2e_3idx_coulomb_integrals , (mo_num,mo_num,mo_num)]
|
||||
&BEGIN_PROVIDER [double precision, tc_2e_3idx_exchange_integrals, (mo_num,mo_num,mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! tc_2e_3idx_coulomb_integrals (j,k,i) = <jk|ji>
|
||||
! tc_2e_3idx_exchange_integrals(j,k,i) = <kj|ji>
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k
|
||||
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
tc_2e_3idx_coulomb_integrals(j, k,i) = mo_bi_ortho_tc_two_e(j ,k ,j ,i )
|
||||
tc_2e_3idx_exchange_integrals(j,k,i) = mo_bi_ortho_tc_two_e(k ,j ,j ,i )
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
@ -1,47 +1,54 @@
|
||||
|
||||
! ---
|
||||
|
||||
subroutine run_stochastic_cipsi
|
||||
|
||||
BEGIN_DOC
|
||||
! Selected Full Configuration Interaction with Stochastic selection and PT2.
|
||||
END_DOC
|
||||
|
||||
use selection_types
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Selected Full Configuration Interaction with Stochastic selection and PT2.
|
||||
END_DOC
|
||||
integer :: i,j,k,ndet
|
||||
double precision, allocatable :: zeros(:)
|
||||
integer :: to_select
|
||||
type(pt2_type) :: pt2_data, pt2_data_err
|
||||
logical, external :: qp_stop
|
||||
logical :: print_pt2
|
||||
integer :: i, j, k, ndet
|
||||
integer :: to_select
|
||||
logical :: print_pt2
|
||||
logical :: has
|
||||
type(pt2_type) :: pt2_data, pt2_data_err
|
||||
double precision :: rss
|
||||
double precision :: correlation_energy_ratio, E_denom, E_tc, norm
|
||||
double precision :: hf_energy_ref
|
||||
double precision :: relative_error
|
||||
double precision, allocatable :: ept2(:), pt1(:), extrap_energy(:)
|
||||
double precision, allocatable :: zeros(:)
|
||||
|
||||
double precision :: rss
|
||||
double precision, external :: memory_of_double
|
||||
double precision :: correlation_energy_ratio,E_denom,E_tc,norm
|
||||
double precision, allocatable :: ept2(:), pt1(:),extrap_energy(:)
|
||||
logical, external :: qp_stop
|
||||
double precision, external :: memory_of_double
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
PROVIDE H_apply_buffer_allocated distributed_davidson
|
||||
|
||||
print*,'Diagonal elements of the Fock matrix '
|
||||
print*, ' Diagonal elements of the Fock matrix '
|
||||
do i = 1, mo_num
|
||||
write(*,*)i,Fock_matrix_tc_mo_tot(i,i)
|
||||
write(*,*) i, Fock_matrix_tc_mo_tot(i,i)
|
||||
enddo
|
||||
|
||||
N_iter = 1
|
||||
threshold_generators = 1.d0
|
||||
SOFT_TOUCH threshold_generators
|
||||
|
||||
rss = memory_of_double(N_states)*4.d0
|
||||
call check_mem(rss,irp_here)
|
||||
call check_mem(rss, irp_here)
|
||||
|
||||
allocate (zeros(N_states))
|
||||
allocate(zeros(N_states))
|
||||
call pt2_alloc(pt2_data, N_states)
|
||||
call pt2_alloc(pt2_data_err, N_states)
|
||||
|
||||
double precision :: hf_energy_ref
|
||||
logical :: has
|
||||
double precision :: relative_error
|
||||
relative_error = PT2_relative_error
|
||||
|
||||
relative_error=PT2_relative_error
|
||||
|
||||
zeros = 0.d0
|
||||
pt2_data % pt2 = -huge(1.e0)
|
||||
pt2_data % rpt2 = -huge(1.e0)
|
||||
pt2_data % overlap= 0.d0
|
||||
zeros = 0.d0
|
||||
pt2_data % pt2 = -huge(1.e0)
|
||||
pt2_data % rpt2 = -huge(1.e0)
|
||||
pt2_data % overlap = 0.d0
|
||||
pt2_data % variance = huge(1.e0)
|
||||
|
||||
!!!! WARNING !!!! SEEMS TO BE PROBLEM WTH make_s2_eigenfunction !!!! THE DETERMINANTS CAN APPEAR TWICE IN THE WFT DURING SELECTION
|
||||
@ -49,7 +56,7 @@ subroutine run_stochastic_cipsi
|
||||
! call make_s2_eigenfunction
|
||||
! endif
|
||||
print_pt2 = .False.
|
||||
call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
|
||||
call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2)
|
||||
! call routine_save_right
|
||||
|
||||
|
||||
@ -74,14 +81,12 @@ subroutine run_stochastic_cipsi
|
||||
! soft_touch thresh_it_dav
|
||||
|
||||
print_pt2 = .True.
|
||||
do while ( &
|
||||
(N_det < N_det_max) .and. &
|
||||
(maxval(abs(pt2_data % pt2(1:N_states))) > pt2_max) &
|
||||
)
|
||||
print*,'maxval(abs(pt2_data % pt2(1:N_states)))',maxval(abs(pt2_data % pt2(1:N_states)))
|
||||
print*,pt2_max
|
||||
write(*,'(A)') '--------------------------------------------------------------------------------'
|
||||
do while( (N_det < N_det_max) .and. &
|
||||
(maxval(abs(pt2_data % pt2(1:N_states))) > pt2_max))
|
||||
|
||||
print*,'maxval(abs(pt2_data % pt2(1:N_states)))',maxval(abs(pt2_data % pt2(1:N_states)))
|
||||
print*,pt2_max
|
||||
write(*,'(A)') '--------------------------------------------------------------------------------'
|
||||
|
||||
to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor)
|
||||
to_select = max(N_states_diag, to_select)
|
||||
@ -94,8 +99,7 @@ subroutine run_stochastic_cipsi
|
||||
call ZMQ_pt2(E_denom, pt2_data, pt2_data_err, relative_error,to_select) ! Stochastic PT2 and selection
|
||||
! stop
|
||||
|
||||
call print_summary(psi_energy_with_nucl_rep, &
|
||||
pt2_data, pt2_data_err, N_det,N_configuration,N_states,psi_s2)
|
||||
call print_summary(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, N_det, N_configuration, N_states, psi_s2)
|
||||
|
||||
call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2)
|
||||
|
||||
@ -109,13 +113,13 @@ subroutine run_stochastic_cipsi
|
||||
! Add selected determinants
|
||||
call copy_H_apply_buffer_to_wf_tc()
|
||||
|
||||
PROVIDE psi_l_coef_bi_ortho psi_r_coef_bi_ortho
|
||||
PROVIDE psi_det
|
||||
PROVIDE psi_det_sorted_tc
|
||||
PROVIDE psi_l_coef_bi_ortho psi_r_coef_bi_ortho
|
||||
PROVIDE psi_det
|
||||
PROVIDE psi_det_sorted_tc
|
||||
|
||||
ept2(N_iter-1) = E_tc + nuclear_repulsion + (pt2_data % pt2(1))/norm
|
||||
pt1(N_iter-1) = dsqrt(pt2_data % overlap(1,1))
|
||||
call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
|
||||
pt1(N_iter-1) = dsqrt(pt2_data % overlap(1,1))
|
||||
call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2)
|
||||
! stop
|
||||
if (qp_stop()) exit
|
||||
enddo
|
||||
|
||||
@ -1,21 +1,29 @@
|
||||
|
||||
subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
|
||||
! ---
|
||||
|
||||
subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2)
|
||||
|
||||
BEGIN_DOC
|
||||
! Replace the coefficients of the CI states by the coefficients of the
|
||||
! eigenstates of the CI matrix
|
||||
END_DOC
|
||||
|
||||
use selection_types
|
||||
implicit none
|
||||
integer, intent(inout) :: ndet ! number of determinants from before
|
||||
double precision, intent(inout) :: E_tc,norm ! E and norm from previous wave function
|
||||
type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function
|
||||
logical, intent(in) :: print_pt2
|
||||
BEGIN_DOC
|
||||
! Replace the coefficients of the CI states by the coefficients of the
|
||||
! eigenstates of the CI matrix
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
double precision :: pt2_tmp,pt1_norm,rpt2_tmp,abs_pt2
|
||||
pt2_tmp = pt2_data % pt2(1)
|
||||
abs_pt2 = pt2_data % variance(1)
|
||||
pt1_norm = pt2_data % overlap(1,1)
|
||||
rpt2_tmp = pt2_tmp/(1.d0 + pt1_norm)
|
||||
integer, intent(inout) :: ndet ! number of determinants from before
|
||||
double precision, intent(inout) :: E_tc, norm ! E and norm from previous wave function
|
||||
type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function
|
||||
logical, intent(in) :: print_pt2
|
||||
integer :: i, j
|
||||
double precision :: pt2_tmp, pt1_norm, rpt2_tmp, abs_pt2
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
pt2_tmp = pt2_data % pt2(1)
|
||||
abs_pt2 = pt2_data % variance(1)
|
||||
pt1_norm = pt2_data % overlap(1,1)
|
||||
rpt2_tmp = pt2_tmp/(1.d0 + pt1_norm)
|
||||
|
||||
print*,'*****'
|
||||
print*,'New wave function information'
|
||||
print*,'N_det tc = ',N_det
|
||||
@ -23,53 +31,61 @@ subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2)
|
||||
print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(1)
|
||||
print*,'Ndet, E_tc = ',N_det,eigval_right_tc_bi_orth(1)
|
||||
print*,'*****'
|
||||
if(print_pt2)then
|
||||
print*,'*****'
|
||||
print*,'previous wave function info'
|
||||
print*,'norm(before) = ',norm
|
||||
print*,'E(before) = ',E_tc
|
||||
print*,'PT1 norm = ',dsqrt(pt1_norm)
|
||||
print*,'PT2 = ',pt2_tmp
|
||||
print*,'rPT2 = ',rpt2_tmp
|
||||
print*,'|PT2| = ',abs_pt2
|
||||
print*,'Positive PT2 = ',(pt2_tmp + abs_pt2)*0.5d0
|
||||
print*,'Negative PT2 = ',(pt2_tmp - abs_pt2)*0.5d0
|
||||
print*,'E(before) + PT2 = ',E_tc + pt2_tmp/norm
|
||||
print*,'E(before) +rPT2 = ',E_tc + rpt2_tmp/norm
|
||||
write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tmp/norm,E_tc + rpt2_tmp/norm,abs_pt2
|
||||
print*,'*****'
|
||||
|
||||
if(print_pt2) then
|
||||
print*,'*****'
|
||||
print*,'previous wave function info'
|
||||
print*,'norm(before) = ',norm
|
||||
print*,'E(before) = ',E_tc
|
||||
print*,'PT1 norm = ',dsqrt(pt1_norm)
|
||||
print*,'PT2 = ',pt2_tmp
|
||||
print*,'rPT2 = ',rpt2_tmp
|
||||
print*,'|PT2| = ',abs_pt2
|
||||
print*,'Positive PT2 = ',(pt2_tmp + abs_pt2)*0.5d0
|
||||
print*,'Negative PT2 = ',(pt2_tmp - abs_pt2)*0.5d0
|
||||
print*,'E(before) + PT2 = ',E_tc + pt2_tmp/norm
|
||||
print*,'E(before) +rPT2 = ',E_tc + rpt2_tmp/norm
|
||||
write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tmp/norm,E_tc + rpt2_tmp/norm,abs_pt2
|
||||
print*,'*****'
|
||||
endif
|
||||
|
||||
psi_energy(1:N_states) = eigval_right_tc_bi_orth(1:N_states) - nuclear_repulsion
|
||||
psi_s2(1:N_states) = s2_eigvec_tc_bi_orth(1:N_states)
|
||||
|
||||
E_tc = eigval_right_tc_bi_orth(1)
|
||||
norm = norm_ground_left_right_bi_orth
|
||||
ndet = N_det
|
||||
do j=1,N_states
|
||||
do i=1,N_det
|
||||
E_tc = eigval_right_tc_bi_orth(1)
|
||||
norm = norm_ground_left_right_bi_orth
|
||||
ndet = N_det
|
||||
do j = 1, N_states
|
||||
do i = 1, N_det
|
||||
psi_l_coef_bi_ortho(i,j) = leigvec_tc_bi_orth(i,j)
|
||||
psi_r_coef_bi_ortho(i,j) = reigvec_tc_bi_orth(i,j)
|
||||
psi_coef(i,j) = dabs(psi_l_coef_bi_ortho(i,j) * psi_r_coef_bi_ortho(i,j))
|
||||
psi_coef(i,j) = dabs(psi_l_coef_bi_ortho(i,j) * psi_r_coef_bi_ortho(i,j))
|
||||
enddo
|
||||
enddo
|
||||
SOFT_TOUCH eigval_left_tc_bi_orth eigval_right_tc_bi_orth leigvec_tc_bi_orth reigvec_tc_bi_orth norm_ground_left_right_bi_orth
|
||||
SOFT_TOUCH eigval_left_tc_bi_orth eigval_right_tc_bi_orth leigvec_tc_bi_orth reigvec_tc_bi_orth norm_ground_left_right_bi_orth
|
||||
SOFT_TOUCH psi_l_coef_bi_ortho psi_r_coef_bi_ortho psi_coef psi_energy psi_s2
|
||||
|
||||
call save_tc_bi_ortho_wavefunction
|
||||
call save_tc_bi_ortho_wavefunction()
|
||||
|
||||
end
|
||||
|
||||
subroutine print_CI_dressed(ndet, E_tc,norm,pt2_data,print_pt2)
|
||||
! ---
|
||||
|
||||
subroutine print_CI_dressed(ndet, E_tc, norm, pt2_data, print_pt2)
|
||||
|
||||
BEGIN_DOC
|
||||
! Replace the coefficients of the CI states by the coefficients of the
|
||||
! eigenstates of the CI matrix
|
||||
END_DOC
|
||||
|
||||
use selection_types
|
||||
implicit none
|
||||
integer, intent(inout) :: ndet ! number of determinants from before
|
||||
double precision, intent(inout) :: E_tc,norm ! E and norm from previous wave function
|
||||
type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function
|
||||
logical, intent(in) :: print_pt2
|
||||
BEGIN_DOC
|
||||
! Replace the coefficients of the CI states by the coefficients of the
|
||||
! eigenstates of the CI matrix
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
integer, intent(inout) :: ndet ! number of determinants from before
|
||||
double precision, intent(inout) :: E_tc,norm ! E and norm from previous wave function
|
||||
type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function
|
||||
logical, intent(in) :: print_pt2
|
||||
integer :: i, j
|
||||
|
||||
print*,'*****'
|
||||
print*,'New wave function information'
|
||||
print*,'N_det tc = ',N_det
|
||||
@ -77,22 +93,25 @@ subroutine print_CI_dressed(ndet, E_tc,norm,pt2_data,print_pt2)
|
||||
print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(1)
|
||||
print*,'Ndet, E_tc = ',N_det,eigval_right_tc_bi_orth(1)
|
||||
print*,'*****'
|
||||
if(print_pt2)then
|
||||
print*,'*****'
|
||||
print*,'previous wave function info'
|
||||
print*,'norm(before) = ',norm
|
||||
print*,'E(before) = ',E_tc
|
||||
print*,'PT1 norm = ',dsqrt(pt2_data % overlap(1,1))
|
||||
print*,'E(before) + PT2 = ',E_tc + (pt2_data % pt2(1))/norm
|
||||
print*,'PT2 = ',pt2_data % pt2(1)
|
||||
print*,'Ndet, E_tc, E+PT2 = ',ndet,E_tc,E_tc + (pt2_data % pt2(1))/norm,dsqrt(pt2_data % overlap(1,1))
|
||||
print*,'*****'
|
||||
|
||||
if(print_pt2) then
|
||||
print*,'*****'
|
||||
print*,'previous wave function info'
|
||||
print*,'norm(before) = ',norm
|
||||
print*,'E(before) = ',E_tc
|
||||
print*,'PT1 norm = ',dsqrt(pt2_data % overlap(1,1))
|
||||
print*,'E(before) + PT2 = ',E_tc + (pt2_data % pt2(1))/norm
|
||||
print*,'PT2 = ',pt2_data % pt2(1)
|
||||
print*,'Ndet, E_tc, E+PT2 = ',ndet,E_tc,E_tc + (pt2_data % pt2(1))/norm,dsqrt(pt2_data % overlap(1,1))
|
||||
print*,'*****'
|
||||
endif
|
||||
|
||||
E_tc = eigval_right_tc_bi_orth(1)
|
||||
norm = norm_ground_left_right_bi_orth
|
||||
ndet = N_det
|
||||
do j=1,N_states
|
||||
do i=1,N_det
|
||||
|
||||
do j = 1, N_states
|
||||
do i = 1, N_det
|
||||
psi_coef(i,j) = reigvec_tc_bi_orth(i,j)
|
||||
enddo
|
||||
enddo
|
||||
@ -100,3 +119,5 @@ subroutine print_CI_dressed(ndet, E_tc,norm,pt2_data,print_pt2)
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
@ -1,5 +1,8 @@
|
||||
program fci
|
||||
implicit none
|
||||
|
||||
! ---
|
||||
|
||||
program fci_tc_bi
|
||||
|
||||
BEGIN_DOC
|
||||
! Selected Full Configuration Interaction with stochastic selection
|
||||
! and PT2.
|
||||
@ -36,21 +39,27 @@ program fci
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
pruning = -1.d0
|
||||
touch pruning
|
||||
|
||||
! pt2_relative_error = 0.01d0
|
||||
! touch pt2_relative_error
|
||||
call run_cipsi_tc
|
||||
|
||||
call run_cipsi_tc()
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine run_cipsi_tc
|
||||
subroutine run_cipsi_tc()
|
||||
|
||||
implicit none
|
||||
|
||||
@ -58,20 +67,21 @@ subroutine run_cipsi_tc
|
||||
|
||||
PROVIDE psi_det psi_coef mo_bi_ortho_tc_two_e mo_bi_ortho_tc_one_e
|
||||
|
||||
if(elec_alpha_num+elec_beta_num .ge. 3) then
|
||||
if(three_body_h_tc)then
|
||||
if((elec_alpha_num+elec_beta_num) .ge. 3) then
|
||||
if(three_body_h_tc) then
|
||||
call provide_all_three_ints_bi_ortho()
|
||||
endif
|
||||
endif
|
||||
|
||||
FREE int2_grad1_u12_bimo_transp int2_grad1_u12_ao_transp
|
||||
FREE int2_grad1_u12_ao int2_grad1_u12_ao_t int2_grad1_u12_ao_transp
|
||||
FREE int2_grad1_u12_bimo_transp
|
||||
|
||||
write(json_unit,json_array_open_fmt) 'fci_tc'
|
||||
|
||||
if (do_pt2) then
|
||||
call run_stochastic_cipsi
|
||||
if(do_pt2) then
|
||||
call run_stochastic_cipsi()
|
||||
else
|
||||
call run_cipsi
|
||||
call run_cipsi()
|
||||
endif
|
||||
|
||||
write(json_unit,json_dict_uopen_fmt)
|
||||
@ -83,13 +93,14 @@ subroutine run_cipsi_tc
|
||||
|
||||
PROVIDE mo_bi_ortho_tc_one_e mo_bi_ortho_tc_two_e pt2_min_parallel_tasks
|
||||
|
||||
if(elec_alpha_num+elec_beta_num.ge.3)then
|
||||
if(three_body_h_tc)then
|
||||
call provide_all_three_ints_bi_ortho
|
||||
if((elec_alpha_num+elec_beta_num) .ge. 3) then
|
||||
if(three_body_h_tc) then
|
||||
call provide_all_three_ints_bi_ortho()
|
||||
endif
|
||||
endif
|
||||
|
||||
FREE int2_grad1_u12_bimo_transp int2_grad1_u12_ao_transp
|
||||
FREE int2_grad1_u12_ao int2_grad1_u12_ao_t int2_grad1_u12_ao_transp
|
||||
FREE int2_grad1_u12_bimo_transp
|
||||
|
||||
call run_slave_cipsi
|
||||
|
||||
|
||||
@ -1,31 +1,42 @@
|
||||
|
||||
! ---
|
||||
|
||||
program tc_pt2_prog
|
||||
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
pruning = -1.d0
|
||||
touch pruning
|
||||
|
||||
! pt2_relative_error = 0.01d0
|
||||
! touch pt2_relative_error
|
||||
call run_pt2_tc
|
||||
call run_pt2_tc()
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine run_pt2_tc
|
||||
subroutine run_pt2_tc()
|
||||
|
||||
implicit none
|
||||
implicit none
|
||||
|
||||
PROVIDE psi_det psi_coef mo_bi_ortho_tc_two_e mo_bi_ortho_tc_one_e
|
||||
if(elec_alpha_num+elec_beta_num.ge.3)then
|
||||
|
||||
if(elec_alpha_num+elec_beta_num.ge.3) then
|
||||
if(three_body_h_tc)then
|
||||
call provide_all_three_ints_bi_ortho
|
||||
call provide_all_three_ints_bi_ortho()
|
||||
endif
|
||||
endif
|
||||
! ---
|
||||
|
||||
call tc_pt2
|
||||
|
||||
call tc_pt2()
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
@ -6,13 +6,9 @@ program debug_fit
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
!my_n_pt_r_grid = 100
|
||||
!my_n_pt_a_grid = 170
|
||||
!my_n_pt_r_grid = 150
|
||||
!my_n_pt_a_grid = 194
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
PROVIDE mu_erf j1b_pen
|
||||
|
||||
@ -6,13 +6,9 @@ program debug_integ_jmu_modif
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
|
||||
!my_n_pt_r_grid = 30
|
||||
!my_n_pt_a_grid = 50
|
||||
!my_n_pt_r_grid = 100
|
||||
!my_n_pt_a_grid = 170
|
||||
my_n_pt_r_grid = 150
|
||||
my_n_pt_a_grid = 194
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
PROVIDE mu_erf j1b_pen
|
||||
@ -48,22 +44,21 @@ subroutine test_v_ij_u_cst_mu_j1b()
|
||||
|
||||
print*, ' test_v_ij_u_cst_mu_j1b ...'
|
||||
|
||||
PROVIDE v_ij_u_cst_mu_j1b
|
||||
PROVIDE v_ij_u_cst_mu_j1b_fit
|
||||
|
||||
eps_ij = 1d-3
|
||||
acc_tot = 0.d0
|
||||
normalz = 0.d0
|
||||
|
||||
!do ipoint = 1, 10
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do j = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
|
||||
i_exc = v_ij_u_cst_mu_j1b(i,j,ipoint)
|
||||
i_num = num_v_ij_u_cst_mu_j1b(i,j,ipoint)
|
||||
i_exc = v_ij_u_cst_mu_j1b_fit(i,j,ipoint)
|
||||
i_num = num_v_ij_u_cst_mu_j1b (i,j,ipoint)
|
||||
acc_ij = dabs(i_exc - i_num)
|
||||
if(acc_ij .gt. eps_ij) then
|
||||
print *, ' problem in v_ij_u_cst_mu_j1b on', i, j, ipoint
|
||||
print *, ' problem in v_ij_u_cst_mu_j1b_fit on', i, j, ipoint
|
||||
print *, ' analyt integ = ', i_exc
|
||||
print *, ' numeri integ = ', i_num
|
||||
print *, ' diff = ', acc_ij
|
||||
|
||||
@ -1,68 +1,3 @@
|
||||
! ---
|
||||
|
||||
!BEGIN_PROVIDER [ double precision, int1_grad2_u12_ao, (3, ao_num, ao_num, n_points_final_grid)]
|
||||
!
|
||||
! BEGIN_DOC
|
||||
! !
|
||||
! ! int1_grad2_u12_ao(:,i,j,ipoint) = \int dr1 [-1 * \grad_r2 J(r1,r2)] \phi_i(r1) \phi_j(r1)
|
||||
! !
|
||||
! ! where r1 = r(ipoint)
|
||||
! !
|
||||
! ! if J(r1,r2) = u12:
|
||||
! !
|
||||
! ! int1_grad2_u12_ao(:,i,j,ipoint) = +0.5 x \int dr1 [-(r1 - r2) (erf(mu * r12)-1)r_12] \phi_i(r1) \phi_j(r1)
|
||||
! ! = -0.5 * [ v_ij_erf_rk_cst_mu(i,j,ipoint) * r(:) - x_v_ij_erf_rk_cst_mu(i,j,ipoint,:) ]
|
||||
! ! = -int2_grad1_u12_ao(i,j,ipoint,:)
|
||||
! !
|
||||
! ! if J(r1,r2) = u12 x v1 x v2
|
||||
! !
|
||||
! ! int1_grad2_u12_ao(:,i,j,ipoint) = v2 x [ 0.5 x \int dr1 [-(r1 - r2) (erf(mu * r12)-1)r_12] v1 \phi_i(r1) \phi_j(r1) ]
|
||||
! ! - \grad_2 v2 x [ \int dr1 u12 v1 \phi_i(r1) \phi_j(r1) ]
|
||||
! ! = -0.5 v_1b(ipoint) * v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) * r(:)
|
||||
! ! + 0.5 v_1b(ipoint) * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,:)
|
||||
! ! - v_1b_grad[:,ipoint] * v_ij_u_cst_mu_j1b(i,j,ipoint)
|
||||
! !
|
||||
! !
|
||||
! END_DOC
|
||||
!
|
||||
! implicit none
|
||||
! integer :: ipoint, i, j
|
||||
! double precision :: x, y, z, tmp_x, tmp_y, tmp_z, tmp0, tmp1, tmp2
|
||||
!
|
||||
! PROVIDE j1b_type
|
||||
!
|
||||
! if(j1b_type .eq. 3) then
|
||||
!
|
||||
! do ipoint = 1, n_points_final_grid
|
||||
! x = final_grid_points(1,ipoint)
|
||||
! y = final_grid_points(2,ipoint)
|
||||
! z = final_grid_points(3,ipoint)
|
||||
!
|
||||
! tmp0 = 0.5d0 * v_1b(ipoint)
|
||||
! tmp_x = v_1b_grad(1,ipoint)
|
||||
! tmp_y = v_1b_grad(2,ipoint)
|
||||
! tmp_z = v_1b_grad(3,ipoint)
|
||||
!
|
||||
! do j = 1, ao_num
|
||||
! do i = 1, ao_num
|
||||
!
|
||||
! tmp1 = tmp0 * v_ij_erf_rk_cst_mu_j1b(i,j,ipoint)
|
||||
! tmp2 = v_ij_u_cst_mu_j1b(i,j,ipoint)
|
||||
!
|
||||
! int1_grad2_u12_ao(1,i,j,ipoint) = -tmp1 * x + tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,1) - tmp2 * tmp_x
|
||||
! int1_grad2_u12_ao(2,i,j,ipoint) = -tmp1 * y + tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,2) - tmp2 * tmp_y
|
||||
! int1_grad2_u12_ao(3,i,j,ipoint) = -tmp1 * z + tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,3) - tmp2 * tmp_z
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
!
|
||||
! else
|
||||
!
|
||||
! int1_grad2_u12_ao = -1.d0 * int2_grad1_u12_ao
|
||||
!
|
||||
! endif
|
||||
!
|
||||
!END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
@ -98,22 +33,14 @@ BEGIN_PROVIDER [double precision, tc_grad_and_lapl_ao_loop, (ao_num, ao_num, ao_
|
||||
weight1 = 0.5d0 * final_weight_at_r_vector(ipoint)
|
||||
|
||||
do i = 1, ao_num
|
||||
!ao_i_r = weight1 * aos_in_r_array_transp (ipoint,i)
|
||||
!ao_i_dx = weight1 * aos_grad_in_r_array_transp_bis(ipoint,i,1)
|
||||
!ao_i_dy = weight1 * aos_grad_in_r_array_transp_bis(ipoint,i,2)
|
||||
!ao_i_dz = weight1 * aos_grad_in_r_array_transp_bis(ipoint,i,3)
|
||||
ao_i_r = weight1 * aos_in_r_array (i,ipoint)
|
||||
ao_i_dx = weight1 * aos_grad_in_r_array(i,ipoint,1)
|
||||
ao_i_dy = weight1 * aos_grad_in_r_array(i,ipoint,2)
|
||||
ao_i_dz = weight1 * aos_grad_in_r_array(i,ipoint,3)
|
||||
|
||||
do k = 1, ao_num
|
||||
!ao_k_r = aos_in_r_array_transp(ipoint,k)
|
||||
ao_k_r = aos_in_r_array(k,ipoint)
|
||||
|
||||
!tmp_x = ao_k_r * ao_i_dx - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)
|
||||
!tmp_y = ao_k_r * ao_i_dy - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)
|
||||
!tmp_z = ao_k_r * ao_i_dz - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)
|
||||
tmp_x = ao_k_r * ao_i_dx - ao_i_r * aos_grad_in_r_array(k,ipoint,1)
|
||||
tmp_y = ao_k_r * ao_i_dy - ao_i_r * aos_grad_in_r_array(k,ipoint,2)
|
||||
tmp_z = ao_k_r * ao_i_dz - ao_i_r * aos_grad_in_r_array(k,ipoint,3)
|
||||
@ -134,44 +61,11 @@ BEGIN_PROVIDER [double precision, tc_grad_and_lapl_ao_loop, (ao_num, ao_num, ao_
|
||||
|
||||
! ---
|
||||
|
||||
!do ipoint = 1, n_points_final_grid
|
||||
! weight1 = 0.5d0 * final_weight_at_r_vector(ipoint)
|
||||
|
||||
! do l = 1, ao_num
|
||||
! ao_l_r = weight1 * aos_in_r_array_transp (ipoint,l)
|
||||
! ao_l_dx = weight1 * aos_grad_in_r_array_transp_bis(ipoint,l,1)
|
||||
! ao_l_dy = weight1 * aos_grad_in_r_array_transp_bis(ipoint,l,2)
|
||||
! ao_l_dz = weight1 * aos_grad_in_r_array_transp_bis(ipoint,l,3)
|
||||
|
||||
! do j = 1, ao_num
|
||||
! ao_j_r = aos_in_r_array_transp(ipoint,j)
|
||||
|
||||
! tmp_x = ao_j_r * ao_l_dx - ao_l_r * aos_grad_in_r_array_transp_bis(ipoint,j,1)
|
||||
! tmp_y = ao_j_r * ao_l_dy - ao_l_r * aos_grad_in_r_array_transp_bis(ipoint,j,2)
|
||||
! tmp_z = ao_j_r * ao_l_dz - ao_l_r * aos_grad_in_r_array_transp_bis(ipoint,j,3)
|
||||
|
||||
! do i = 1, ao_num
|
||||
! do k = 1, ao_num
|
||||
|
||||
! contrib_x = int2_grad1_u12_ao(k,i,ipoint,1) * tmp_x
|
||||
! contrib_y = int2_grad1_u12_ao(k,i,ipoint,2) * tmp_y
|
||||
! contrib_z = int2_grad1_u12_ao(k,i,ipoint,3) * tmp_z
|
||||
|
||||
! ac_mat(k,i,l,j) += contrib_x + contrib_y + contrib_z
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
!enddo
|
||||
|
||||
! ---
|
||||
|
||||
do j = 1, ao_num
|
||||
do l = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
do k = 1, ao_num
|
||||
tc_grad_and_lapl_ao_loop(k,i,l,j) = ac_mat(k,i,l,j) + ac_mat(l,j,k,i)
|
||||
!tc_grad_and_lapl_ao_loop(k,i,l,j) = ac_mat(k,i,l,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
@ -70,14 +70,15 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f
|
||||
|
||||
elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 4)) then
|
||||
|
||||
PROVIDE v_1b_grad v_ij_erf_rk_cst_mu_j1b v_ij_u_cst_mu_j1b x_v_ij_erf_rk_cst_mu_j1b
|
||||
PROVIDE v_1b_grad
|
||||
PROVIDE v_ij_erf_rk_cst_mu_j1b v_ij_u_cst_mu_j1b_an x_v_ij_erf_rk_cst_mu_j1b
|
||||
|
||||
int2_grad1_u12_ao = 0.d0
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp_x, tmp_y, tmp_z) &
|
||||
!$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points, v_1b, v_1b_grad &
|
||||
!$OMP , v_ij_erf_rk_cst_mu_j1b, v_ij_u_cst_mu_j1b, x_v_ij_erf_rk_cst_mu_j1b, int2_grad1_u12_ao)
|
||||
!$OMP , v_ij_erf_rk_cst_mu_j1b, v_ij_u_cst_mu_j1b_an, x_v_ij_erf_rk_cst_mu_j1b, int2_grad1_u12_ao)
|
||||
!$OMP DO SCHEDULE (static)
|
||||
do ipoint = 1, n_points_final_grid
|
||||
x = final_grid_points(1,ipoint)
|
||||
@ -90,7 +91,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f
|
||||
do j = 1, ao_num
|
||||
do i = 1, ao_num
|
||||
tmp1 = tmp0 * v_ij_erf_rk_cst_mu_j1b(i,j,ipoint)
|
||||
tmp2 = v_ij_u_cst_mu_j1b(i,j,ipoint)
|
||||
tmp2 = v_ij_u_cst_mu_j1b_an(i,j,ipoint)
|
||||
int2_grad1_u12_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,1) - tmp2 * tmp_x
|
||||
int2_grad1_u12_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,2) - tmp2 * tmp_y
|
||||
int2_grad1_u12_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,3) - tmp2 * tmp_z
|
||||
@ -100,7 +101,7 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
FREE v_ij_erf_rk_cst_mu_j1b v_ij_u_cst_mu_j1b x_v_ij_erf_rk_cst_mu_j1b
|
||||
FREE v_ij_erf_rk_cst_mu_j1b v_ij_u_cst_mu_j1b_an x_v_ij_erf_rk_cst_mu_j1b
|
||||
|
||||
elseif(j1b_type .ge. 100) then
|
||||
|
||||
|
||||
@ -1,19 +1,18 @@
|
||||
|
||||
! ---
|
||||
|
||||
program test_non_h
|
||||
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 50
|
||||
my_n_pt_a_grid = 74
|
||||
!my_n_pt_r_grid = 400
|
||||
!my_n_pt_a_grid = 974
|
||||
|
||||
! my_n_pt_r_grid = 10 ! small grid for quick debug
|
||||
! my_n_pt_a_grid = 26 ! small grid for quick debug
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
!call routine_grad_squared
|
||||
!call routine_fit
|
||||
!call routine_grad_squared()
|
||||
!call routine_fit()
|
||||
|
||||
call test_ipp()
|
||||
end
|
||||
|
||||
@ -3,8 +3,9 @@ program compute_deltamu_right
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
|
||||
@ -6,10 +6,9 @@ program tc_bi_ortho
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
!my_n_pt_r_grid = 100
|
||||
!my_n_pt_a_grid = 170
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
call ERI_dump()
|
||||
|
||||
@ -7,16 +7,12 @@ program print_tc_energy
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
|
||||
!my_n_pt_r_grid = 100
|
||||
!my_n_pt_a_grid = 170
|
||||
|
||||
!my_n_pt_r_grid = 100
|
||||
!my_n_pt_a_grid = 266
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
@ -24,8 +20,6 @@ program print_tc_energy
|
||||
PROVIDE j1b_type
|
||||
print*, 'j1b_type = ', j1b_type
|
||||
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
call write_tc_energy()
|
||||
|
||||
end
|
||||
|
||||
@ -1,16 +1,26 @@
|
||||
|
||||
! ---
|
||||
|
||||
program test_spin_dens
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Reads psi_det in the EZFIO folder and prints out the left- and right-eigenvectors together with the energy. Saves the left-right wave functions at the end.
|
||||
! TODO : Reads psi_det in the EZFIO folder and prints out the left- and right-eigenvectors together with the energy. Saves the left-right wave functions at the end.
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
call tc_print_mulliken_sd
|
||||
! call test
|
||||
|
||||
call tc_print_mulliken_sd()
|
||||
!call test
|
||||
|
||||
end
|
||||
|
||||
@ -7,12 +7,15 @@ program print_tc_var
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
call write_tc_var()
|
||||
|
||||
|
||||
@ -1,20 +1,31 @@
|
||||
|
||||
! ---
|
||||
|
||||
program print_tc_bi_ortho
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
! if(three_body_h_tc)then
|
||||
! call provide_all_three_ints_bi_ortho
|
||||
! endif
|
||||
! call routine
|
||||
call write_l_r_wf
|
||||
call write_l_r_wf
|
||||
|
||||
end
|
||||
|
||||
subroutine write_l_r_wf
|
||||
|
||||
@ -7,12 +7,16 @@ program pt2_tc_cisd
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
print*, ' nb of states = ', N_states
|
||||
print*, ' nb of det = ', N_det
|
||||
|
||||
@ -1,35 +1,59 @@
|
||||
program tc_natorb_bi_ortho
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
print *, 'Hello world'
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
call print_energy_and_mos
|
||||
call save_tc_natorb
|
||||
! call minimize_tc_orb_angles
|
||||
end
|
||||
|
||||
subroutine save_tc_natorb
|
||||
|
||||
! ---
|
||||
|
||||
program tc_natorb_bi_ortho
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
|
||||
call print_energy_and_mos()
|
||||
call save_tc_natorb()
|
||||
!call minimize_tc_orb_angles()
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine save_tc_natorb()
|
||||
|
||||
implicit none
|
||||
|
||||
print*,'Saving the natorbs '
|
||||
|
||||
provide natorb_tc_leigvec_ao natorb_tc_reigvec_ao
|
||||
|
||||
call ezfio_set_bi_ortho_mos_mo_l_coef(natorb_tc_leigvec_ao)
|
||||
call ezfio_set_bi_ortho_mos_mo_r_coef(natorb_tc_reigvec_ao)
|
||||
call save_ref_determinant_nstates_1
|
||||
call save_ref_determinant_nstates_1()
|
||||
call ezfio_set_determinants_read_wf(.False.)
|
||||
end
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine save_ref_determinant_nstates_1
|
||||
implicit none
|
||||
subroutine save_ref_determinant_nstates_1()
|
||||
|
||||
use bitmasks
|
||||
double precision :: buffer(1,N_states)
|
||||
implicit none
|
||||
double precision :: buffer(1,N_states)
|
||||
|
||||
buffer = 0.d0
|
||||
buffer(1,1) = 1.d0
|
||||
call save_wavefunction_general(1,1,ref_bitmask,1,buffer)
|
||||
end
|
||||
call save_wavefunction_general(1, 1, ref_bitmask, 1, buffer)
|
||||
|
||||
end
|
||||
|
||||
|
||||
@ -1,15 +1,24 @@
|
||||
program tc_bi_ortho
|
||||
implicit none
|
||||
|
||||
! ---
|
||||
|
||||
program select_dets_bi_ortho()
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
!!!!!!!!!!!!!!! WARNING NO 3-BODY
|
||||
!!!!!!!!!!!!!!! WARNING NO 3-BODY
|
||||
@ -22,6 +31,8 @@ program tc_bi_ortho
|
||||
! call test
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine routine_test
|
||||
implicit none
|
||||
use bitmasks ! you need to include the bitmasks_module.f90 features
|
||||
@ -57,5 +68,7 @@ subroutine routine_test
|
||||
enddo
|
||||
call save_wavefunction_general(n_good,n_states,dets,n_good,coef_new)
|
||||
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
@ -1,4 +1,6 @@
|
||||
|
||||
! ---
|
||||
|
||||
subroutine diag_htilde_three_body_ints_bi_ort_slow(Nint, key_i, hthree)
|
||||
|
||||
BEGIN_DOC
|
||||
@ -14,81 +16,89 @@ subroutine diag_htilde_three_body_ints_bi_ort_slow(Nint, key_i, hthree)
|
||||
integer :: occ(Nint*bit_kind_size,2)
|
||||
integer :: Ne(2),i,j,ii,jj,ispin,jspin,m,mm
|
||||
integer(bit_kind) :: key_i_core(Nint,2)
|
||||
double precision :: direct_int, exchange_int
|
||||
double precision :: sym_3_e_int_from_6_idx_tensor
|
||||
double precision :: three_e_diag_parrallel_spin
|
||||
double precision :: direct_int, exchange_int, ref
|
||||
double precision, external :: sym_3_e_int_from_6_idx_tensor
|
||||
double precision, external :: three_e_diag_parrallel_spin
|
||||
|
||||
if(core_tc_op)then
|
||||
do i = 1, Nint
|
||||
key_i_core(i,1) = xor(key_i(i,1),core_bitmask(i,1))
|
||||
key_i_core(i,2) = xor(key_i(i,2),core_bitmask(i,2))
|
||||
enddo
|
||||
call bitstring_to_list_ab(key_i_core,occ,Ne,Nint)
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
if(core_tc_op) then
|
||||
do i = 1, Nint
|
||||
key_i_core(i,1) = xor(key_i(i,1), core_bitmask(i,1))
|
||||
key_i_core(i,2) = xor(key_i(i,2), core_bitmask(i,2))
|
||||
enddo
|
||||
call bitstring_to_list_ab(key_i_core, occ, Ne, Nint)
|
||||
else
|
||||
call bitstring_to_list_ab(key_i,occ,Ne,Nint)
|
||||
call bitstring_to_list_ab(key_i, occ, Ne, Nint)
|
||||
endif
|
||||
|
||||
hthree = 0.d0
|
||||
|
||||
if(Ne(1)+Ne(2).ge.3)then
|
||||
!! ! alpha/alpha/beta three-body
|
||||
do i = 1, Ne(1)
|
||||
ii = occ(i,1)
|
||||
do j = i+1, Ne(1)
|
||||
jj = occ(j,1)
|
||||
do m = 1, Ne(2)
|
||||
mm = occ(m,2)
|
||||
! direct_int = three_body_ints_bi_ort(mm,jj,ii,mm,jj,ii) USES THE 6-IDX TENSOR
|
||||
! exchange_int = three_body_ints_bi_ort(mm,jj,ii,mm,ii,jj) USES THE 6-IDX TENSOR
|
||||
direct_int = three_e_3_idx_direct_bi_ort(mm,jj,ii) ! USES 3-IDX TENSOR
|
||||
exchange_int = three_e_3_idx_exch12_bi_ort(mm,jj,ii) ! USES 3-IDX TENSOR
|
||||
hthree += direct_int - exchange_int
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
if((Ne(1)+Ne(2)) .ge. 3) then
|
||||
|
||||
! beta/beta/alpha three-body
|
||||
do i = 1, Ne(2)
|
||||
ii = occ(i,2)
|
||||
do j = i+1, Ne(2)
|
||||
jj = occ(j,2)
|
||||
do m = 1, Ne(1)
|
||||
mm = occ(m,1)
|
||||
direct_int = three_e_3_idx_direct_bi_ort(mm,jj,ii)
|
||||
exchange_int = three_e_3_idx_exch12_bi_ort(mm,jj,ii)
|
||||
hthree += direct_int - exchange_int
|
||||
enddo
|
||||
! alpha/alpha/beta three-body
|
||||
do i = 1, Ne(1)
|
||||
ii = occ(i,1)
|
||||
do j = i+1, Ne(1)
|
||||
jj = occ(j,1)
|
||||
do m = 1, Ne(2)
|
||||
mm = occ(m,2)
|
||||
!direct_int = three_body_ints_bi_ort(mm,jj,ii,mm,jj,ii) !uses the 6-idx tensor
|
||||
!exchange_int = three_body_ints_bi_ort(mm,jj,ii,mm,ii,jj) !uses the 6-idx tensor
|
||||
direct_int = three_e_3_idx_direct_bi_ort(mm,jj,ii) !uses 3-idx tensor
|
||||
exchange_int = three_e_3_idx_exch12_bi_ort(mm,jj,ii) !uses 3-idx tensor
|
||||
hthree += direct_int - exchange_int
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! alpha/alpha/alpha three-body
|
||||
do i = 1, Ne(1)
|
||||
ii = occ(i,1) ! 1
|
||||
do j = i+1, Ne(1)
|
||||
jj = occ(j,1) ! 2
|
||||
do m = j+1, Ne(1)
|
||||
mm = occ(m,1) ! 3
|
||||
! ref = sym_3_e_int_from_6_idx_tensor(mm,jj,ii,mm,jj,ii) USES THE 6 IDX TENSOR
|
||||
hthree += three_e_diag_parrallel_spin(mm,jj,ii) ! USES ONLY 3-IDX TENSORS
|
||||
enddo
|
||||
! beta/beta/alpha three-body
|
||||
do i = 1, Ne(2)
|
||||
ii = occ(i,2)
|
||||
do j = i+1, Ne(2)
|
||||
jj = occ(j,2)
|
||||
do m = 1, Ne(1)
|
||||
mm = occ(m,1)
|
||||
!direct_int = three_body_ints_bi_ort(mm,jj,ii,mm,jj,ii) !uses the 6-idx tensor
|
||||
!exchange_int = three_body_ints_bi_ort(mm,jj,ii,mm,ii,jj) !uses the 6-idx tensor
|
||||
direct_int = three_e_3_idx_direct_bi_ort(mm,jj,ii)
|
||||
exchange_int = three_e_3_idx_exch12_bi_ort(mm,jj,ii)
|
||||
hthree += direct_int - exchange_int
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! beta/beta/beta three-body
|
||||
do i = 1, Ne(2)
|
||||
ii = occ(i,2) ! 1
|
||||
do j = i+1, Ne(2)
|
||||
jj = occ(j,2) ! 2
|
||||
do m = j+1, Ne(2)
|
||||
mm = occ(m,2) ! 3
|
||||
! ref = sym_3_e_int_from_6_idx_tensor(mm,jj,ii,mm,jj,ii) USES THE 6 IDX TENSOR
|
||||
hthree += three_e_diag_parrallel_spin(mm,jj,ii) ! USES ONLY 3-IDX TENSORS
|
||||
enddo
|
||||
! alpha/alpha/alpha three-body
|
||||
do i = 1, Ne(1)
|
||||
ii = occ(i,1) ! 1
|
||||
do j = i+1, Ne(1)
|
||||
jj = occ(j,1) ! 2
|
||||
do m = j+1, Ne(1)
|
||||
mm = occ(m,1) ! 3
|
||||
!hthree += sym_3_e_int_from_6_idx_tensor(mm,jj,ii,mm,jj,ii) !uses the 6 idx tensor
|
||||
hthree += three_e_diag_parrallel_spin(mm,jj,ii) !uses only 3-idx tensors
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! beta/beta/beta three-body
|
||||
do i = 1, Ne(2)
|
||||
ii = occ(i,2) ! 1
|
||||
do j = i+1, Ne(2)
|
||||
jj = occ(j,2) ! 2
|
||||
do m = j+1, Ne(2)
|
||||
mm = occ(m,2) ! 3
|
||||
!hthree += sym_3_e_int_from_6_idx_tensor(mm,jj,ii,mm,jj,ii) !uses the 6 idx tensor
|
||||
hthree += three_e_diag_parrallel_spin(mm,jj,ii) !uses only 3-idx tensors
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine single_htilde_three_body_ints_bi_ort_slow(Nint, key_j, key_i, hthree)
|
||||
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
|
||||
! ---
|
||||
|
||||
subroutine provide_all_three_ints_bi_ortho()
|
||||
@ -25,9 +26,9 @@ subroutine provide_all_three_ints_bi_ortho()
|
||||
PROVIDE normal_two_body_bi_orth
|
||||
endif
|
||||
|
||||
endif
|
||||
endif
|
||||
|
||||
return
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
@ -46,13 +47,19 @@ subroutine htilde_mu_mat_opt_bi_ortho_tot(key_j, key_i, Nint, htot)
|
||||
END_DOC
|
||||
|
||||
use bitmasks
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||
double precision, intent(out) :: htot
|
||||
double precision :: hmono, htwoe, hthree
|
||||
call htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree, htot)
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||
double precision, intent(out) :: htot
|
||||
double precision :: hmono, htwoe, hthree
|
||||
|
||||
call htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree, htot)
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree, htot)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! <key_j | H_tilde | key_i> where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis
|
||||
@ -80,11 +87,11 @@ subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree,
|
||||
call get_excitation_degree(key_i, key_j, degree, Nint)
|
||||
if(degree.gt.2) return
|
||||
|
||||
if(degree == 0)then
|
||||
if(degree == 0) then
|
||||
call diag_htilde_mu_mat_fock_bi_ortho (Nint, key_i, hmono, htwoe, hthree, htot)
|
||||
else if (degree == 1)then
|
||||
call single_htilde_mu_mat_fock_bi_ortho(Nint,key_j, key_i , hmono, htwoe, hthree, htot)
|
||||
else if(degree == 2)then
|
||||
else if (degree == 1) then
|
||||
call single_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i , hmono, htwoe, hthree, htot)
|
||||
else if(degree == 2) then
|
||||
call double_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i, hmono, htwoe, hthree, htot)
|
||||
endif
|
||||
|
||||
|
||||
@ -1,32 +1,48 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ref_tc_energy_tot]
|
||||
&BEGIN_PROVIDER [ double precision, ref_tc_energy_1e]
|
||||
&BEGIN_PROVIDER [ double precision, ref_tc_energy_2e]
|
||||
&BEGIN_PROVIDER [ double precision, ref_tc_energy_3e]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Various component of the TC energy for the reference "HF" Slater determinant
|
||||
END_DOC
|
||||
double precision :: hmono, htwoe, htot, hthree
|
||||
call diag_htilde_mu_mat_bi_ortho_slow(N_int,HF_bitmask , hmono, htwoe, htot)
|
||||
ref_tc_energy_1e = hmono
|
||||
ref_tc_energy_2e = htwoe
|
||||
if(three_body_h_tc)then
|
||||
call diag_htilde_three_body_ints_bi_ort_slow(N_int, HF_bitmask, hthree)
|
||||
ref_tc_energy_3e = hthree
|
||||
else
|
||||
ref_tc_energy_3e = 0.d0
|
||||
endif
|
||||
ref_tc_energy_tot = ref_tc_energy_1e + ref_tc_energy_2e + ref_tc_energy_3e + nuclear_repulsion
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_DOC
|
||||
! Various component of the TC energy for the reference "HF" Slater determinant
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
double precision :: hmono, htwoe, htot, hthree
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
call diag_htilde_mu_mat_bi_ortho_slow(N_int, HF_bitmask, hmono, htwoe, htot)
|
||||
|
||||
ref_tc_energy_1e = hmono
|
||||
ref_tc_energy_2e = htwoe
|
||||
|
||||
if(three_body_h_tc) then
|
||||
call diag_htilde_three_body_ints_bi_ort_slow(N_int, HF_bitmask, hthree)
|
||||
ref_tc_energy_3e = hthree
|
||||
else
|
||||
ref_tc_energy_3e = 0.d0
|
||||
endif
|
||||
|
||||
ref_tc_energy_tot = ref_tc_energy_1e + ref_tc_energy_2e + ref_tc_energy_3e + nuclear_repulsion
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
subroutine diag_htilde_mu_mat_fock_bi_ortho(Nint, det_in, hmono, htwoe, hthree, htot)
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! Computes $\langle i|H|i \rangle$.
|
||||
END_DOC
|
||||
integer,intent(in) :: Nint
|
||||
integer(bit_kind),intent(in) :: det_in(Nint,2)
|
||||
double precision, intent(out) :: hmono,htwoe,htot,hthree
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: det_in(Nint,2)
|
||||
double precision, intent(out) :: hmono, htwoe, htot, hthree
|
||||
|
||||
integer(bit_kind) :: hole(Nint,2)
|
||||
integer(bit_kind) :: particle(Nint,2)
|
||||
@ -40,7 +56,6 @@ subroutine diag_htilde_mu_mat_fock_bi_ortho(Nint, det_in, hmono, htwoe, hthree,
|
||||
ASSERT (sum(popcnt(det_in(:,1))) == elec_alpha_num)
|
||||
ASSERT (sum(popcnt(det_in(:,2))) == elec_beta_num)
|
||||
|
||||
|
||||
nexc(1) = 0
|
||||
nexc(2) = 0
|
||||
do i=1,Nint
|
||||
@ -55,15 +70,15 @@ subroutine diag_htilde_mu_mat_fock_bi_ortho(Nint, det_in, hmono, htwoe, hthree,
|
||||
enddo
|
||||
|
||||
if (nexc(1)+nexc(2) == 0) then
|
||||
hmono = ref_tc_energy_1e
|
||||
htwoe = ref_tc_energy_2e
|
||||
hthree= ref_tc_energy_3e
|
||||
htot = ref_tc_energy_tot
|
||||
hmono = ref_tc_energy_1e
|
||||
htwoe = ref_tc_energy_2e
|
||||
hthree = ref_tc_energy_3e
|
||||
htot = ref_tc_energy_tot
|
||||
return
|
||||
endif
|
||||
|
||||
!call debug_det(det_in,Nint)
|
||||
integer :: tmp(2)
|
||||
integer :: tmp(2)
|
||||
!DIR$ FORCEINLINE
|
||||
call bitstring_to_list_ab(particle, occ_particle, tmp, Nint)
|
||||
ASSERT (tmp(1) == nexc(1)) ! Number of particles alpha
|
||||
@ -73,27 +88,31 @@ subroutine diag_htilde_mu_mat_fock_bi_ortho(Nint, det_in, hmono, htwoe, hthree,
|
||||
ASSERT (tmp(1) == nexc(1)) ! Number of holes alpha
|
||||
ASSERT (tmp(2) == nexc(2)) ! Number of holes beta
|
||||
|
||||
|
||||
hmono = ref_tc_energy_1e
|
||||
htwoe = ref_tc_energy_2e
|
||||
hthree = ref_tc_energy_3e
|
||||
|
||||
det_tmp = ref_bitmask
|
||||
hmono = ref_tc_energy_1e
|
||||
htwoe = ref_tc_energy_2e
|
||||
hthree= ref_tc_energy_3e
|
||||
do ispin=1,2
|
||||
|
||||
do ispin = 1, 2
|
||||
na = elec_num_tab(ispin)
|
||||
nb = elec_num_tab(iand(ispin,1)+1)
|
||||
do i=1,nexc(ispin)
|
||||
do i = 1, nexc(ispin)
|
||||
!DIR$ FORCEINLINE
|
||||
call ac_tc_operator( occ_particle(i,ispin), ispin, det_tmp, hmono,htwoe,hthree, Nint,na,nb)
|
||||
call ac_tc_operator(occ_particle(i,ispin), ispin, det_tmp, hmono, htwoe, hthree, Nint, na, nb)
|
||||
!DIR$ FORCEINLINE
|
||||
call a_tc_operator ( occ_hole (i,ispin), ispin, det_tmp, hmono,htwoe,hthree, Nint,na,nb)
|
||||
call a_tc_operator (occ_hole (i,ispin), ispin, det_tmp, hmono, htwoe, hthree, Nint, na, nb)
|
||||
enddo
|
||||
enddo
|
||||
htot = hmono+htwoe+hthree+nuclear_repulsion
|
||||
|
||||
htot = hmono + htwoe + hthree + nuclear_repulsion
|
||||
|
||||
end
|
||||
|
||||
subroutine ac_tc_operator(iorb,ispin,key,hmono,htwoe,hthree,Nint,na,nb)
|
||||
use bitmasks
|
||||
implicit none
|
||||
! ---
|
||||
|
||||
subroutine ac_tc_operator(iorb, ispin, key, hmono, htwoe, hthree, Nint, na, nb)
|
||||
|
||||
BEGIN_DOC
|
||||
! Routine that computes one- and two-body energy corresponding
|
||||
!
|
||||
@ -105,17 +124,20 @@ subroutine ac_tc_operator(iorb,ispin,key,hmono,htwoe,hthree,Nint,na,nb)
|
||||
!
|
||||
! and the quantities hmono,htwoe,hthree are INCREMENTED
|
||||
END_DOC
|
||||
integer, intent(in) :: iorb, ispin, Nint
|
||||
integer, intent(inout) :: na, nb
|
||||
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer, intent(in) :: iorb, ispin, Nint
|
||||
integer, intent(inout) :: na, nb
|
||||
integer(bit_kind), intent(inout) :: key(Nint,2)
|
||||
double precision, intent(inout) :: hmono,htwoe,hthree
|
||||
double precision, intent(inout) :: hmono, htwoe, hthree
|
||||
|
||||
integer :: occ(Nint*bit_kind_size,2)
|
||||
integer :: other_spin
|
||||
integer :: k,l,i,jj,mm,j,m
|
||||
double precision :: direct_int, exchange_int
|
||||
integer :: occ(Nint*bit_kind_size,2)
|
||||
integer :: other_spin
|
||||
integer :: k, l, i, jj, mm, j, m
|
||||
integer :: tmp(2)
|
||||
double precision :: direct_int, exchange_int
|
||||
|
||||
|
||||
if (iorb < 1) then
|
||||
print *, irp_here, ': iorb < 1'
|
||||
print *, iorb, mo_num
|
||||
@ -131,7 +153,6 @@ subroutine ac_tc_operator(iorb,ispin,key,hmono,htwoe,hthree,Nint,na,nb)
|
||||
ASSERT (ispin < 3)
|
||||
ASSERT (Nint > 0)
|
||||
|
||||
integer :: tmp(2)
|
||||
!DIR$ FORCEINLINE
|
||||
call bitstring_to_list_ab(key, occ, tmp, Nint)
|
||||
ASSERT (tmp(1) == elec_alpha_num)
|
||||
@ -147,50 +168,54 @@ subroutine ac_tc_operator(iorb,ispin,key,hmono,htwoe,hthree,Nint,na,nb)
|
||||
hmono = hmono + mo_bi_ortho_tc_one_e(iorb,iorb)
|
||||
|
||||
! Same spin
|
||||
do i=1,na
|
||||
do i = 1, na
|
||||
htwoe = htwoe + mo_bi_ortho_tc_two_e_jj_anti(occ(i,ispin),iorb)
|
||||
enddo
|
||||
|
||||
! Opposite spin
|
||||
do i=1,nb
|
||||
do i = 1, nb
|
||||
htwoe = htwoe + mo_bi_ortho_tc_two_e_jj(occ(i,other_spin),iorb)
|
||||
enddo
|
||||
|
||||
if(three_body_h_tc.and.elec_num.gt.2.and.three_e_3_idx_term)then
|
||||
!!!!! 3-e part
|
||||
!! same-spin/same-spin
|
||||
do j = 1, na
|
||||
jj = occ(j,ispin)
|
||||
do m = j+1, na
|
||||
mm = occ(m,ispin)
|
||||
hthree += three_e_diag_parrallel_spin_prov(mm,jj,iorb)
|
||||
if(three_body_h_tc .and. (elec_num.gt.2) .and. three_e_3_idx_term) then
|
||||
|
||||
!!!!! 3-e part
|
||||
!! same-spin/same-spin
|
||||
do j = 1, na
|
||||
jj = occ(j,ispin)
|
||||
do m = j+1, na
|
||||
mm = occ(m,ispin)
|
||||
hthree += three_e_diag_parrallel_spin_prov(mm,jj,iorb)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!! same-spin/oposite-spin
|
||||
do j = 1, na
|
||||
jj = occ(j,ispin)
|
||||
do m = 1, nb
|
||||
mm = occ(m,other_spin)
|
||||
direct_int = three_e_3_idx_direct_bi_ort(mm,jj,iorb) ! USES 3-IDX TENSOR
|
||||
exchange_int = three_e_3_idx_exch12_bi_ort(mm,jj,iorb) ! USES 3-IDX TENSOR
|
||||
hthree += direct_int - exchange_int
|
||||
!! same-spin/oposite-spin
|
||||
do j = 1, na
|
||||
jj = occ(j,ispin)
|
||||
do m = 1, nb
|
||||
mm = occ(m,other_spin)
|
||||
direct_int = three_e_3_idx_direct_bi_ort(mm,jj,iorb) ! USES 3-IDX TENSOR
|
||||
exchange_int = three_e_3_idx_exch12_bi_ort(mm,jj,iorb) ! USES 3-IDX TENSOR
|
||||
hthree += direct_int - exchange_int
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!! oposite-spin/opposite-spin
|
||||
!! oposite-spin/opposite-spin
|
||||
do j = 1, nb
|
||||
jj = occ(j,other_spin)
|
||||
do m = j+1, nb
|
||||
mm = occ(m,other_spin)
|
||||
direct_int = three_e_3_idx_direct_bi_ort(mm,jj,iorb) ! USES 3-IDX TENSOR
|
||||
exchange_int = three_e_3_idx_exch23_bi_ort(mm,jj,iorb) ! USES 3-IDX TENSOR
|
||||
hthree += direct_int - exchange_int
|
||||
enddo
|
||||
jj = occ(j,other_spin)
|
||||
do m = j+1, nb
|
||||
mm = occ(m,other_spin)
|
||||
direct_int = three_e_3_idx_direct_bi_ort(mm,jj,iorb) ! USES 3-IDX TENSOR
|
||||
exchange_int = three_e_3_idx_exch23_bi_ort(mm,jj,iorb) ! USES 3-IDX TENSOR
|
||||
hthree += direct_int - exchange_int
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
|
||||
na = na+1
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine a_tc_operator(iorb,ispin,key,hmono,htwoe,hthree,Nint,na,nb)
|
||||
use bitmasks
|
||||
implicit none
|
||||
@ -460,14 +485,16 @@ subroutine a_tc_operator_no_3e(iorb,ispin,key,hmono,htwoe,Nint,na,nb)
|
||||
hmono = hmono - mo_bi_ortho_tc_one_e(iorb,iorb)
|
||||
|
||||
! Same spin
|
||||
do i=1,na
|
||||
htwoe= htwoe- mo_bi_ortho_tc_two_e_jj_anti(occ(i,ispin),iorb)
|
||||
do i = 1, na
|
||||
htwoe = htwoe- mo_bi_ortho_tc_two_e_jj_anti(occ(i,ispin),iorb)
|
||||
enddo
|
||||
|
||||
! Opposite spin
|
||||
do i=1,nb
|
||||
htwoe= htwoe- mo_bi_ortho_tc_two_e_jj(occ(i,other_spin),iorb)
|
||||
do i = 1, nb
|
||||
htwoe = htwoe- mo_bi_ortho_tc_two_e_jj(occ(i,other_spin),iorb)
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
@ -21,7 +21,7 @@ subroutine htilde_mu_mat_bi_ortho_tot_slow(key_j, key_i, Nint, htot)
|
||||
integer :: degree
|
||||
|
||||
call get_excitation_degree(key_j, key_i, degree, Nint)
|
||||
if(degree.gt.2)then
|
||||
if(degree.gt.2) then
|
||||
htot = 0.d0
|
||||
else
|
||||
call htilde_mu_mat_bi_ortho_slow(key_j, key_i, Nint, hmono, htwoe, hthree, htot)
|
||||
@ -60,22 +60,22 @@ subroutine htilde_mu_mat_bi_ortho_slow(key_j, key_i, Nint, hmono, htwoe, hthree,
|
||||
call get_excitation_degree(key_i, key_j, degree, Nint)
|
||||
if(degree.gt.2) return
|
||||
|
||||
if(degree == 0)then
|
||||
if(degree == 0) then
|
||||
call diag_htilde_mu_mat_bi_ortho_slow(Nint, key_i, hmono, htwoe, htot)
|
||||
else if (degree == 1)then
|
||||
else if (degree == 1) then
|
||||
call single_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
else if(degree == 2)then
|
||||
else if(degree == 2) then
|
||||
call double_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
endif
|
||||
|
||||
if(three_body_h_tc) then
|
||||
if(degree == 2) then
|
||||
if(.not.double_normal_ord.and.elec_num.gt.2.and.three_e_5_idx_term) then
|
||||
if((.not.double_normal_ord) .and. (elec_num .gt. 2) .and. three_e_5_idx_term) then
|
||||
call double_htilde_three_body_ints_bi_ort_slow(Nint, key_j, key_i, hthree)
|
||||
endif
|
||||
else if(degree == 1.and.elec_num.gt.2.and.three_e_4_idx_term) then
|
||||
else if((degree == 1) .and. (elec_num .gt. 2) .and. three_e_4_idx_term) then
|
||||
call single_htilde_three_body_ints_bi_ort_slow(Nint, key_j, key_i, hthree)
|
||||
else if(degree == 0.and.elec_num.gt.2.and.three_e_3_idx_term) then
|
||||
else if((degree == 0) .and. (elec_num .gt. 2) .and. three_e_3_idx_term) then
|
||||
call diag_htilde_three_body_ints_bi_ort_slow(Nint, key_i, hthree)
|
||||
endif
|
||||
endif
|
||||
@ -106,6 +106,8 @@ subroutine diag_htilde_mu_mat_bi_ortho_slow(Nint, key_i, hmono, htwoe, htot)
|
||||
double precision :: get_mo_two_e_integral_tc_int
|
||||
integer(bit_kind) :: key_i_core(Nint,2)
|
||||
|
||||
PROVIDE mo_bi_ortho_tc_two_e
|
||||
|
||||
! PROVIDE mo_two_e_integrals_tc_int_in_map mo_bi_ortho_tc_two_e
|
||||
!
|
||||
! PROVIDE mo_integrals_erf_map core_energy nuclear_repulsion core_bitmask
|
||||
@ -135,15 +137,6 @@ subroutine diag_htilde_mu_mat_bi_ortho_slow(Nint, key_i, hmono, htwoe, htot)
|
||||
ii = occ(i,ispin)
|
||||
hmono += mo_bi_ortho_tc_one_e(ii,ii)
|
||||
|
||||
! if(j1b_gauss .eq. 1) then
|
||||
! print*,'j1b not implemented for bi ortho TC'
|
||||
! print*,'stopping ....'
|
||||
! stop
|
||||
! !hmono += mo_j1b_gauss_hermI (ii,ii) &
|
||||
! ! + mo_j1b_gauss_hermII (ii,ii) &
|
||||
! ! + mo_j1b_gauss_nonherm(ii,ii)
|
||||
! endif
|
||||
|
||||
! if(core_tc_op)then
|
||||
! print*,'core_tc_op not already taken into account for bi ortho'
|
||||
! print*,'stopping ...'
|
||||
|
||||
@ -41,14 +41,21 @@ subroutine give_all_perm_for_three_e(n,l,k,m,j,i,idx_list,phase)
|
||||
|
||||
end
|
||||
|
||||
double precision function sym_3_e_int_from_6_idx_tensor(n,l,k,m,j,i)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! returns all good combinations of permutations of integrals with the good signs
|
||||
!
|
||||
! for a given (k^dagger l^dagger n^dagger m j i) <nlk|L|mji> when all indices have the same spins
|
||||
END_DOC
|
||||
integer, intent(in) :: n,l,k,m,j,i
|
||||
! ---
|
||||
|
||||
double precision function sym_3_e_int_from_6_idx_tensor(n, l, k, m, j, i)
|
||||
|
||||
BEGIN_DOC
|
||||
! returns all good combinations of permutations of integrals with the good signs
|
||||
!
|
||||
! for a given (k^dagger l^dagger n^dagger m j i) <nlk|L|mji> when all indices have the same spins
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: n, l, k, m, j, i
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
sym_3_e_int_from_6_idx_tensor = three_body_ints_bi_ort(n,l,k,m,j,i) & ! direct
|
||||
+ three_body_ints_bi_ort(n,l,k,j,i,m) & ! 1st cyclic permutation
|
||||
+ three_body_ints_bi_ort(n,l,k,i,m,j) & ! 2nd cyclic permutation
|
||||
@ -56,8 +63,11 @@ double precision function sym_3_e_int_from_6_idx_tensor(n,l,k,m,j,i)
|
||||
- three_body_ints_bi_ort(n,l,k,i,j,m) & ! elec 2 is kept fixed
|
||||
- three_body_ints_bi_ort(n,l,k,m,i,j) ! elec 3 is kept fixed
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
double precision function direct_sym_3_e_int(n,l,k,m,j,i)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -83,15 +93,25 @@ double precision function direct_sym_3_e_int(n,l,k,m,j,i)
|
||||
|
||||
end
|
||||
|
||||
double precision function three_e_diag_parrallel_spin(m,j,i)
|
||||
implicit none
|
||||
integer, intent(in) :: i,j,m
|
||||
! ---
|
||||
|
||||
double precision function three_e_diag_parrallel_spin(m, j, i)
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: i, j, m
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
three_e_diag_parrallel_spin = three_e_3_idx_direct_bi_ort(m,j,i) ! direct
|
||||
three_e_diag_parrallel_spin += three_e_3_idx_cycle_1_bi_ort(m,j,i) + three_e_3_idx_cycle_2_bi_ort(m,j,i) & ! two cyclic permutations
|
||||
- three_e_3_idx_exch23_bi_ort(m,j,i) - three_e_3_idx_exch13_bi_ort(m,j,i) & ! two first exchange
|
||||
- three_e_3_idx_exch12_bi_ort(m,j,i) ! last exchange
|
||||
- three_e_3_idx_exch23_bi_ort (m,j,i) - three_e_3_idx_exch13_bi_ort(m,j,i) & ! two first exchange
|
||||
- three_e_3_idx_exch12_bi_ort (m,j,i) ! last exchange
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
double precision function three_e_single_parrallel_spin(m,j,k,i)
|
||||
implicit none
|
||||
integer, intent(in) :: i,k,j,m
|
||||
|
||||
@ -8,11 +8,13 @@ program tc_bi_ortho
|
||||
END_DOC
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
print*, ' nb of states = ', N_states
|
||||
print*, ' nb of det = ', N_det
|
||||
@ -20,22 +22,29 @@ program tc_bi_ortho
|
||||
call routine_diag()
|
||||
call write_tc_energy()
|
||||
call save_tc_bi_ortho_wavefunction()
|
||||
end
|
||||
|
||||
subroutine test
|
||||
implicit none
|
||||
integer :: i,j
|
||||
double precision :: hmono,htwoe,hthree,htot
|
||||
use bitmasks
|
||||
print*,'reading the wave function '
|
||||
do i = 1, N_det
|
||||
call debug_det(psi_det(1,1,i),N_int)
|
||||
print*,i,psi_l_coef_bi_ortho(i,1)*psi_r_coef_bi_ortho(i,1)
|
||||
print*,i,psi_l_coef_bi_ortho(i,1),psi_r_coef_bi_ortho(i,1)
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine test()
|
||||
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer :: i, j
|
||||
double precision :: hmono, htwoe, hthree, htot
|
||||
|
||||
print*, 'reading the wave function '
|
||||
do i = 1, N_det
|
||||
call debug_det(psi_det(1,1,i), N_int)
|
||||
print*, i, psi_l_coef_bi_ortho(i,1)*psi_r_coef_bi_ortho(i,1)
|
||||
print*, i, psi_l_coef_bi_ortho(i,1),psi_r_coef_bi_ortho(i,1)
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine routine_diag()
|
||||
|
||||
implicit none
|
||||
|
||||
@ -1,19 +1,32 @@
|
||||
|
||||
! ---
|
||||
|
||||
program tc_bi_ortho_prop
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
! call routine_diag
|
||||
call test
|
||||
|
||||
!call routine_diag
|
||||
call test
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine test
|
||||
implicit none
|
||||
integer :: i
|
||||
|
||||
@ -1,20 +1,32 @@
|
||||
program tc_bi_ortho
|
||||
implicit none
|
||||
|
||||
! ---
|
||||
|
||||
program tc_cisd_sc2
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
call test
|
||||
|
||||
end
|
||||
|
||||
subroutine test
|
||||
! ---
|
||||
|
||||
subroutine test()
|
||||
implicit none
|
||||
! double precision, allocatable :: dressing_dets(:),e_corr_dets(:)
|
||||
! allocate(dressing_dets(N_det),e_corr_dets(N_det))
|
||||
|
||||
@ -1,42 +1,56 @@
|
||||
|
||||
! ---
|
||||
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [ integer, index_HF_psi_det]
|
||||
implicit none
|
||||
integer :: i,degree
|
||||
do i = 1, N_det
|
||||
call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
|
||||
if(degree == 0)then
|
||||
index_HF_psi_det = i
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
END_PROVIDER
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [integer, index_HF_psi_det]
|
||||
|
||||
subroutine diagonalize_CI_tc
|
||||
implicit none
|
||||
integer :: i, degree
|
||||
|
||||
do i = 1, N_det
|
||||
call get_excitation_degree(HF_bitmask, psi_det(1,1,i), degree, N_int)
|
||||
if(degree == 0) then
|
||||
index_HF_psi_det = i
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
subroutine diagonalize_CI_tc()
|
||||
|
||||
BEGIN_DOC
|
||||
! Replace the coefficients of the |CI| states by the coefficients of the
|
||||
! eigenstates of the |CI| matrix.
|
||||
! Replace the coefficients of the |CI| states by the coefficients of the
|
||||
! eigenstates of the |CI| matrix.
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
do j=1,N_states
|
||||
do i=1,N_det
|
||||
|
||||
implicit none
|
||||
integer :: i, j
|
||||
|
||||
do j = 1, N_states
|
||||
do i = 1, N_det
|
||||
psi_l_coef_bi_ortho(i,j) = leigvec_tc_bi_orth(i,j)
|
||||
psi_r_coef_bi_ortho(i,j) = reigvec_tc_bi_orth(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
SOFT_TOUCH psi_l_coef_bi_ortho psi_r_coef_bi_ortho
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
BEGIN_PROVIDER [double precision, eigval_right_tc_bi_orth, (N_states)]
|
||||
&BEGIN_PROVIDER [double precision, eigval_left_tc_bi_orth, (N_states)]
|
||||
&BEGIN_PROVIDER [double precision, reigvec_tc_bi_orth, (N_det,N_states)]
|
||||
&BEGIN_PROVIDER [double precision, leigvec_tc_bi_orth, (N_det,N_states)]
|
||||
&BEGIN_PROVIDER [double precision, s2_eigvec_tc_bi_orth, (N_states)]
|
||||
&BEGIN_PROVIDER [double precision, norm_ground_left_right_bi_orth ]
|
||||
BEGIN_PROVIDER [double precision, eigval_right_tc_bi_orth, (N_states) ]
|
||||
&BEGIN_PROVIDER [double precision, eigval_left_tc_bi_orth , (N_states) ]
|
||||
&BEGIN_PROVIDER [double precision, reigvec_tc_bi_orth , (N_det,N_states)]
|
||||
&BEGIN_PROVIDER [double precision, leigvec_tc_bi_orth , (N_det,N_states)]
|
||||
&BEGIN_PROVIDER [double precision, s2_eigvec_tc_bi_orth , (N_states) ]
|
||||
&BEGIN_PROVIDER [double precision, norm_ground_left_right_bi_orth ]
|
||||
|
||||
BEGIN_DOC
|
||||
! eigenvalues, right and left eigenvectors of the transcorrelated Hamiltonian on the BI-ORTHO basis
|
||||
@ -44,29 +58,29 @@ end
|
||||
|
||||
implicit none
|
||||
integer :: i, idx_dress, j, istate, k
|
||||
integer :: i_good_state, i_other_state, i_state
|
||||
integer :: n_real_tc_bi_orth_eigval_right, igood_r, igood_l
|
||||
logical :: converged, dagger
|
||||
integer :: n_real_tc_bi_orth_eigval_right,igood_r,igood_l
|
||||
double precision, allocatable :: reigvec_tc_bi_orth_tmp(:,:),leigvec_tc_bi_orth_tmp(:,:),eigval_right_tmp(:)
|
||||
double precision, parameter :: alpha = 0.1d0
|
||||
integer, allocatable :: index_good_state_array(:)
|
||||
integer, allocatable :: iorder(:)
|
||||
logical, allocatable :: good_state_array(:)
|
||||
double precision, allocatable :: reigvec_tc_bi_orth_tmp(:,:), leigvec_tc_bi_orth_tmp(:,:),eigval_right_tmp(:)
|
||||
double precision, allocatable :: s2_values_tmp(:), H_prime(:,:), expect_e(:)
|
||||
double precision, parameter :: alpha = 0.1d0
|
||||
integer :: i_good_state,i_other_state, i_state
|
||||
integer, allocatable :: index_good_state_array(:)
|
||||
logical, allocatable :: good_state_array(:)
|
||||
double precision, allocatable :: coef_hf_r(:),coef_hf_l(:)
|
||||
double precision, allocatable :: Stmp(:,:)
|
||||
integer, allocatable :: iorder(:)
|
||||
double precision, allocatable :: coef_hf_r(:),coef_hf_l(:)
|
||||
double precision, allocatable :: Stmp(:,:)
|
||||
|
||||
PROVIDE N_det N_int
|
||||
|
||||
if(n_det .le. N_det_max_full) then
|
||||
if(N_det .le. N_det_max_full) then
|
||||
|
||||
allocate(reigvec_tc_bi_orth_tmp(N_det,N_det),leigvec_tc_bi_orth_tmp(N_det,N_det),eigval_right_tmp(N_det),expect_e(N_det))
|
||||
allocate (H_prime(N_det,N_det),s2_values_tmp(N_det))
|
||||
allocate(reigvec_tc_bi_orth_tmp(N_det,N_det), leigvec_tc_bi_orth_tmp(N_det,N_det), eigval_right_tmp(N_det), expect_e(N_det))
|
||||
allocate(H_prime(N_det,N_det), s2_values_tmp(N_det))
|
||||
|
||||
H_prime(1:N_det,1:N_det) = htilde_matrix_elmt_bi_ortho(1:N_det,1:N_det)
|
||||
if(s2_eig) then
|
||||
H_prime(1:N_det,1:N_det) += alpha * S2_matrix_all_dets(1:N_det,1:N_det)
|
||||
do j=1,N_det
|
||||
do j = 1, N_det
|
||||
H_prime(j,j) = H_prime(j,j) - alpha*expected_s2
|
||||
enddo
|
||||
endif
|
||||
|
||||
@ -31,7 +31,9 @@
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, htilde_matrix_elmt_bi_ortho_tranp, (N_det,N_det)]
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, htilde_matrix_elmt_bi_ortho_tranp, (N_det,N_det)]
|
||||
implicit none
|
||||
integer ::i,j
|
||||
do i = 1, N_det
|
||||
|
||||
@ -12,10 +12,9 @@ program tc_som
|
||||
print *, ' do not forget to do tc-scf first'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
! my_n_pt_r_grid = 10 ! small grid for quick debug
|
||||
! my_n_pt_a_grid = 26 ! small grid for quick debug
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
PROVIDE mu_erf
|
||||
|
||||
@ -1,21 +1,34 @@
|
||||
|
||||
! ---
|
||||
|
||||
program test_natorb
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Reads psi_det in the EZFIO folder and prints out the left- and right-eigenvectors together with the energy. Saves the left-right wave functions at the end.
|
||||
! TODO : Reads psi_det in the EZFIO folder and prints out the left- and right-eigenvectors together with the energy. Saves the left-right wave functions at the end.
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
call routine
|
||||
! call test
|
||||
|
||||
call routine()
|
||||
! call test()
|
||||
|
||||
end
|
||||
|
||||
subroutine routine
|
||||
! ---
|
||||
|
||||
subroutine routine()
|
||||
|
||||
implicit none
|
||||
double precision, allocatable :: fock_diag(:),eigval(:),leigvec(:,:),reigvec(:,:),mat_ref(:,:)
|
||||
allocate(eigval(mo_num),leigvec(mo_num,mo_num),reigvec(mo_num,mo_num),fock_diag(mo_num),mat_ref(mo_num, mo_num))
|
||||
|
||||
@ -1,19 +1,32 @@
|
||||
|
||||
! ---
|
||||
|
||||
program test_normal_order
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
call provide_all_three_ints_bi_ortho
|
||||
call test
|
||||
|
||||
call provide_all_three_ints_bi_ortho()
|
||||
call test()
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine test
|
||||
implicit none
|
||||
use bitmasks ! you need to include the bitmasks_module.f90 features
|
||||
|
||||
@ -1,14 +1,22 @@
|
||||
|
||||
! ---
|
||||
|
||||
program test_tc
|
||||
implicit none
|
||||
read_wf = .True.
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
call routine_test_s2
|
||||
call routine_test_s2_davidson
|
||||
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
|
||||
call routine_test_s2
|
||||
call routine_test_s2_davidson
|
||||
|
||||
end
|
||||
|
||||
subroutine routine_test_s2
|
||||
|
||||
@ -1,15 +1,24 @@
|
||||
|
||||
! ---
|
||||
|
||||
program tc_bi_ortho
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
! call test_h_u0
|
||||
! call test_slater_tc_opt
|
||||
|
||||
@ -1,22 +1,32 @@
|
||||
|
||||
! ---
|
||||
|
||||
program test_tc_fock
|
||||
implicit none
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
print *, 'Hello world'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
!call routine_1
|
||||
!call routine_2
|
||||
! call routine_3()
|
||||
|
||||
! call test_3e
|
||||
call routine_tot
|
||||
call routine_tot
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
@ -262,3 +262,16 @@ doc: If |true|, use Manu IPP
|
||||
interface: ezfio,provider,ocaml
|
||||
default: True
|
||||
|
||||
[tc_grid1_a]
|
||||
type: integer
|
||||
doc: size of angular grid over r1
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 50
|
||||
|
||||
[tc_grid1_r]
|
||||
type: integer
|
||||
doc: size of radial grid over r1
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 30
|
||||
|
||||
|
||||
|
||||
@ -10,8 +10,9 @@ program combine_lr_tcscf
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
bi_ortho = .True.
|
||||
|
||||
@ -1,17 +1,26 @@
|
||||
program print_angles
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! program that minimizes the angle between left- and right-orbitals when degeneracies are found in the TC-Fock matrix
|
||||
END_DOC
|
||||
|
||||
! ---
|
||||
|
||||
program minimize_tc_angles
|
||||
|
||||
BEGIN_DOC
|
||||
! program that minimizes the angle between left- and right-orbitals when degeneracies are found in the TC-Fock matrix
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_n_pt_r_grid my_n_pt_a_grid
|
||||
! call sort_by_tc_fock
|
||||
|
||||
! call sort_by_tc_fock
|
||||
|
||||
! TODO
|
||||
! check if rotations of orbitals affect the TC energy
|
||||
! and refuse the step
|
||||
call minimize_tc_orb_angles
|
||||
|
||||
end
|
||||
|
||||
|
||||
@ -11,10 +11,9 @@ program molden_lr_mos
|
||||
print *, 'starting ...'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
! my_n_pt_r_grid = 10 ! small grid for quick debug
|
||||
! my_n_pt_a_grid = 26 ! small grid for quick debug
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
!call molden_lr
|
||||
|
||||
@ -7,10 +7,9 @@ program print_fit_param
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
! my_n_pt_r_grid = 10 ! small grid for quick debug
|
||||
! my_n_pt_a_grid = 26 ! small grid for quick debug
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
!call create_guess
|
||||
|
||||
@ -8,16 +8,9 @@ program print_tcscf_energy
|
||||
|
||||
print *, 'Hello world'
|
||||
my_grid_becke = .True.
|
||||
|
||||
!my_n_pt_r_grid = 30
|
||||
!my_n_pt_a_grid = 50
|
||||
|
||||
my_n_pt_r_grid = 100
|
||||
my_n_pt_a_grid = 170
|
||||
|
||||
!my_n_pt_r_grid = 100
|
||||
!my_n_pt_a_grid = 266
|
||||
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
call main()
|
||||
|
||||
@ -10,8 +10,9 @@ program rotate_tcscf_orbitals
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
bi_ortho = .True.
|
||||
|
||||
@ -10,10 +10,9 @@ program tc_petermann_factor
|
||||
implicit none
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
! my_n_pt_r_grid = 10 ! small grid for quick debug
|
||||
! my_n_pt_a_grid = 26 ! small grid for quick debug
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
call main()
|
||||
|
||||
@ -14,14 +14,10 @@ program tc_scf
|
||||
|
||||
my_grid_becke = .True.
|
||||
|
||||
!my_n_pt_r_grid = 30
|
||||
!my_n_pt_a_grid = 50
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
|
||||
my_n_pt_r_grid = 100
|
||||
my_n_pt_a_grid = 170
|
||||
|
||||
! my_n_pt_r_grid = 10 ! small grid for quick debug
|
||||
! my_n_pt_a_grid = 26 ! small grid for quick debug
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
PROVIDE mu_erf
|
||||
|
||||
@ -9,10 +9,9 @@ program test_ints
|
||||
print *, ' starting test_ints ...'
|
||||
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
! my_n_pt_r_grid = 15 ! small grid for quick debug
|
||||
! my_n_pt_a_grid = 26 ! small grid for quick debug
|
||||
PROVIDE tc_grid1_a tc_grid1_r
|
||||
my_n_pt_r_grid = tc_grid1_r
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
my_extra_grid_becke = .True.
|
||||
@ -280,7 +279,7 @@ subroutine routine_v_ij_u_cst_mu_j1b_test
|
||||
do i = 1, ao_num
|
||||
do j = 1, ao_num
|
||||
array(j,i,l,k) += v_ij_u_cst_mu_j1b_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight
|
||||
array_ref(j,i,l,k) += v_ij_u_cst_mu_j1b(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight
|
||||
array_ref(j,i,l,k) += v_ij_u_cst_mu_j1b_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
@ -506,7 +505,7 @@ subroutine routine_v_ij_u_cst_mu_j1b
|
||||
do i = 1, ao_num
|
||||
do j = 1, ao_num
|
||||
array(j,i,l,k) += v_ij_u_cst_mu_j1b_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight
|
||||
array_ref(j,i,l,k) += v_ij_u_cst_mu_j1b(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight
|
||||
array_ref(j,i,l,k) += v_ij_u_cst_mu_j1b_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
@ -418,7 +418,7 @@ subroutine gaussian_product_x(a,xa,b,xb,k,p,xp)
|
||||
xab = xa-xb
|
||||
ab = ab*p_inv
|
||||
k = ab*xab*xab
|
||||
if (k > 40.d0) then
|
||||
if (k > 400.d0) then
|
||||
k=0.d0
|
||||
return
|
||||
endif
|
||||
|
||||
Loading…
Reference in New Issue
Block a user