mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-06-02 03:15:25 +02:00
145 lines
3.6 KiB
Fortran
145 lines
3.6 KiB
Fortran
program print_ij_H_kl_det_v0
|
|
|
|
implicit none
|
|
|
|
BEGIN_DOC
|
|
! perturbative approach to build psi_postsvd
|
|
! without OMP
|
|
END_DOC
|
|
|
|
read_wf = .True.
|
|
TOUCH read_wf
|
|
|
|
PROVIDE N_int
|
|
|
|
call run()
|
|
end
|
|
|
|
|
|
subroutine run
|
|
|
|
USE OMP_LIB
|
|
|
|
implicit none
|
|
|
|
integer(bit_kind) :: det1(N_int,2), det2(N_int,2)
|
|
integer :: degree, i_state
|
|
double precision :: h12
|
|
|
|
integer(kind=8) :: W_tbeg, W_tend, W_tbeg_it, W_tend_it, W_ir
|
|
real(kind=8) :: W_tot_time
|
|
integer :: nb_taches
|
|
|
|
!$OMP PARALLEL
|
|
nb_taches = OMP_GET_NUM_THREADS()
|
|
!$OMP END PARALLEL
|
|
|
|
call SYSTEM_CLOCK(COUNT=W_tbeg, COUNT_RATE=W_ir)
|
|
|
|
i_state = 1
|
|
|
|
det1(:,1) = psi_det_alpha_unique(:,1)
|
|
det2(:,1) = psi_det_alpha_unique(:,1)
|
|
det1(:,2) = psi_det_beta_unique(:,1)
|
|
det2(:,2) = psi_det_beta_unique(:,1)
|
|
call get_excitation_degree_spin(det1(1,1),det2(1,1),degree,N_int)
|
|
call get_excitation_degree(det1,det2,degree,N_int)
|
|
call i_H_j(det1, det2, N_int, h12)
|
|
|
|
! ---------------------------------------------------------------------------------------
|
|
! construct the initial CI matrix
|
|
|
|
print *, ' ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~'
|
|
print *, ' CISD matrix:', n_det_alpha_unique,'x',n_det_beta_unique
|
|
print *, ' N det :', N_det
|
|
print *, ' ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~'
|
|
|
|
! ---------------------------------------------------------------------------------------
|
|
|
|
! get < d_i d_j | H | d_k d_l > in det basis
|
|
call const_ij_H_kl_det()
|
|
|
|
|
|
call SYSTEM_CLOCK(COUNT=W_tend, COUNT_RATE=W_ir)
|
|
W_tot_time = real(W_tend - W_tbeg, kind=8) / real(W_ir, kind=8)
|
|
print *, ' ___________________________________________________________________'
|
|
print *, ' '
|
|
!print *, " Execution avec ", nb_taches, "threads"
|
|
print *, " Execution avec 1 threads"
|
|
print *, " total elapsed time (min) = ", W_tot_time/60.d0
|
|
print *, ' ___________________________________________________________________'
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
subroutine const_ij_H_kl_det()
|
|
|
|
implicit none
|
|
|
|
integer(bit_kind) :: det1(N_int,2)
|
|
integer(bit_kind) :: det2(N_int,2)
|
|
integer :: degree, na, nb
|
|
|
|
integer :: i, j, k, l
|
|
double precision :: h12
|
|
|
|
double precision :: nb_nz, n_tot
|
|
|
|
double precision :: t1, t2
|
|
|
|
print *, ""
|
|
print *, " start const_ij_H_kl_det"
|
|
call wall_time(t1)
|
|
|
|
na = n_det_alpha_unique
|
|
nb = n_det_beta_unique
|
|
|
|
nb_nz = 0.d0
|
|
do l = 1, nb
|
|
det2(:,2) = psi_det_beta_unique(:,l)
|
|
do j = 1, nb
|
|
det1(:,2) = psi_det_beta_unique(:,j)
|
|
|
|
call get_excitation_degree_spin(det1(1,2),det2(1,2),degree,N_int)
|
|
if(degree .gt. 2) cycle
|
|
|
|
do k = 1, na
|
|
det2(:,1) = psi_det_alpha_unique(:,k)
|
|
do i = 1, na
|
|
det1(:,1) = psi_det_alpha_unique(:,i)
|
|
|
|
call get_excitation_degree(det1,det2,degree,N_int)
|
|
if(degree .gt. 2) cycle
|
|
|
|
call i_H_j(det1, det2, N_int, h12)
|
|
if(dabs(h12).le.(1d-12)) cycle
|
|
|
|
! need nbs
|
|
nb_nz = nb_nz + 1.d0
|
|
write(7000, '(4(I8,2X),(F20.13))') i, j, k, l, h12
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
|
|
n_tot = dble(na)**2 * dble(nb)**2
|
|
|
|
print *, ' na = ', na
|
|
print *, ' nb = ', nb
|
|
|
|
print *, ' nb non zero elemenets = ', nb_nz
|
|
print *, ' n_tot = ', n_tot
|
|
|
|
print *, ' % non zero elemenets = ', 100.d0 * dexp( dlog(nb_nz) - dlog(n_tot) )
|
|
|
|
call wall_time(t2)
|
|
print *, " end const_ij_H_kl_det after (min) ", (t2-t1)/60.
|
|
print *, ""
|
|
|
|
return
|
|
end subroutine const_ij_H_kl_det
|
|
|