mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-29 20:23:40 +02:00
Merge branch 'dev-stable-tc-scf' of https://github.com/AbdAmmar/qp2 into dev-stable-tc-scf
This commit is contained in:
commit
6f0faaccdb
@ -10,7 +10,10 @@ program tc_bi_ortho
|
|||||||
my_n_pt_a_grid = 50
|
my_n_pt_a_grid = 50
|
||||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||||
|
|
||||||
|
call ERI_dump()
|
||||||
call KMat_tilde_dump()
|
call KMat_tilde_dump()
|
||||||
|
call LMat_tilde_dump()
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
@ -18,7 +21,7 @@ end
|
|||||||
subroutine KMat_tilde_dump()
|
subroutine KMat_tilde_dump()
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i, j, k, l
|
integer :: i, j, k, l
|
||||||
|
|
||||||
PROVIDE mo_bi_ortho_tc_two_e_chemist
|
PROVIDE mo_bi_ortho_tc_two_e_chemist
|
||||||
|
|
||||||
@ -42,3 +45,91 @@ subroutine KMat_tilde_dump()
|
|||||||
end subroutine KMat_tilde_dump
|
end subroutine KMat_tilde_dump
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
|
subroutine ERI_dump()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j, k, l
|
||||||
|
double precision, allocatable :: a1(:,:,:,:), a2(:,:,:,:)
|
||||||
|
|
||||||
|
PROVIDE mo_r_coef mo_l_coef
|
||||||
|
|
||||||
|
allocate(a2(ao_num,ao_num,ao_num,mo_num))
|
||||||
|
|
||||||
|
call dgemm( 'T', 'N', ao_num*ao_num*ao_num, mo_num, ao_num, 1.d0 &
|
||||||
|
, ao_two_e_coul(1,1,1,1), ao_num, mo_l_coef(1,1), ao_num &
|
||||||
|
, 0.d0 , a2(1,1,1,1), ao_num*ao_num*ao_num)
|
||||||
|
|
||||||
|
allocate(a1(ao_num,ao_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
call dgemm( 'T', 'N', ao_num*ao_num*mo_num, mo_num, ao_num, 1.d0 &
|
||||||
|
, a2(1,1,1,1), ao_num, mo_r_coef(1,1), ao_num &
|
||||||
|
, 0.d0, a1(1,1,1,1), ao_num*ao_num*mo_num)
|
||||||
|
|
||||||
|
deallocate(a2)
|
||||||
|
allocate(a2(ao_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
call dgemm( 'T', 'N', ao_num*mo_num*mo_num, mo_num, ao_num, 1.d0 &
|
||||||
|
, a1(1,1,1,1), ao_num, mo_l_coef(1,1), ao_num &
|
||||||
|
, 0.d0, a2(1,1,1,1), ao_num*mo_num*mo_num)
|
||||||
|
|
||||||
|
deallocate(a1)
|
||||||
|
allocate(a1(mo_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
call dgemm( 'T', 'N', mo_num*mo_num*mo_num, mo_num, ao_num, 1.d0 &
|
||||||
|
, a2(1,1,1,1), ao_num, mo_r_coef(1,1), ao_num &
|
||||||
|
, 0.d0, a1(1,1,1,1), mo_num*mo_num*mo_num)
|
||||||
|
|
||||||
|
deallocate(a2)
|
||||||
|
|
||||||
|
open(33, file='ERI.dat', action='write')
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
write(33, '(4(I4, 2X), 4X, E15.7)') i, j, k, l, a1(i,j,k,l)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
close(33)
|
||||||
|
|
||||||
|
deallocate(a1)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine ERI_dump
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine LMat_tilde_dump()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j, k, l, m, n
|
||||||
|
double precision :: integral
|
||||||
|
|
||||||
|
PROVIDE mo_bi_ortho_tc_two_e_chemist
|
||||||
|
|
||||||
|
print *, ' Lmat_tilde in phys notation'
|
||||||
|
|
||||||
|
open(33, file='Lmat_tilde.dat', action='write')
|
||||||
|
do n = 1, mo_num
|
||||||
|
do m = 1, mo_num
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
! < i j k | -L | l m n > with a BI-ORTHONORMAL MOLECULAR ORBITALS
|
||||||
|
call give_integrals_3_body_bi_ort(i, j, k, l, m, n, integral)
|
||||||
|
write(33, '(6(I4, 2X), 4X, E15.7)') i, j, k, l, m, n, integral
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
close(33)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine LMat_tilde_dump
|
||||||
|
|
||||||
|
! ---
|
||||||
|
@ -1,19 +1,31 @@
|
|||||||
program print_tc_energy
|
program print_tc_energy
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! TODO : Put the documentation of the program here
|
! TODO : Put the documentation of the program here
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
print *, 'Hello world'
|
print *, 'Hello world'
|
||||||
my_grid_becke = .True.
|
my_grid_becke = .True.
|
||||||
my_n_pt_r_grid = 30
|
!my_n_pt_r_grid = 30
|
||||||
my_n_pt_a_grid = 50
|
!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
|
||||||
|
|
||||||
read_wf = .True.
|
read_wf = .True.
|
||||||
touch read_wf
|
touch read_wf
|
||||||
|
|
||||||
PROVIDE j1b_type
|
PROVIDE j1b_type
|
||||||
print*, 'j1b_type = ', j1b_type
|
print*, 'j1b_type = ', j1b_type
|
||||||
|
|
||||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||||
call write_tc_energy
|
|
||||||
|
call write_tc_energy()
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -55,7 +55,7 @@ subroutine htilde_mu_mat_bi_ortho_slow(key_j, key_i, Nint, hmono, htwoe, hthree,
|
|||||||
hmono = 0.d0
|
hmono = 0.d0
|
||||||
htwoe = 0.d0
|
htwoe = 0.d0
|
||||||
htot = 0.d0
|
htot = 0.d0
|
||||||
hthree = 0.D0
|
hthree = 0.d0
|
||||||
|
|
||||||
call get_excitation_degree(key_i, key_j, degree, Nint)
|
call get_excitation_degree(key_i, key_j, degree, Nint)
|
||||||
if(degree.gt.2) return
|
if(degree.gt.2) return
|
||||||
|
@ -91,7 +91,7 @@
|
|||||||
print *, ' parameters for nuclei jastrow'
|
print *, ' parameters for nuclei jastrow'
|
||||||
print *, ' i, Z, j1b_pen, j1b_pen_coef'
|
print *, ' i, Z, j1b_pen, j1b_pen_coef'
|
||||||
do i = 1, nucl_num
|
do i = 1, nucl_num
|
||||||
print *, i, nucl_charge(i), j1b_pen(i), j1b_pen_coef(i)
|
write(*,"(I4, 2x, 3(E15.7, 2X))"), i, nucl_charge(i), j1b_pen(i), j1b_pen_coef(i)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
@ -78,6 +78,7 @@ end
|
|||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
|
! TODO DGEMM
|
||||||
BEGIN_PROVIDER [double precision, diag_three_elem_hf]
|
BEGIN_PROVIDER [double precision, diag_three_elem_hf]
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
@ -106,7 +107,7 @@ BEGIN_PROVIDER [double precision, diag_three_elem_hf]
|
|||||||
do i = 1, elec_beta_num
|
do i = 1, elec_beta_num
|
||||||
do j = 1, elec_beta_num
|
do j = 1, elec_beta_num
|
||||||
do k = 1, elec_beta_num
|
do k = 1, elec_beta_num
|
||||||
call give_integrals_3_body(k, j, i, j, i, k,exchange_int_231)
|
call give_integrals_3_body(k, j, i, j, i, k, exchange_int_231)
|
||||||
diag_three_elem_hf += two_third * exchange_int_231
|
diag_three_elem_hf += two_third * exchange_int_231
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
Loading…
Reference in New Issue
Block a user