10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-07-22 10:47:38 +02:00

Comments in Davidson

This commit is contained in:
Anthony Scemama 2023-02-01 13:58:05 +01:00
parent 030dc9acf6
commit 8a52b46b48
5 changed files with 56 additions and 19 deletions

View File

@ -250,12 +250,12 @@ compute_singles=.True.
ASSERT (istep > 0)
!$OMP DO SCHEDULE(guided,64)
do k_a=istart+ishift,iend,istep
do k_a=istart+ishift,iend,istep ! Loop over all determinants (/!\ not in psidet order)
krow = psi_bilinear_matrix_rows(k_a)
krow = psi_bilinear_matrix_rows(k_a) ! Index of alpha part of determinant k_a
ASSERT (krow <= N_det_alpha_unique)
kcol = psi_bilinear_matrix_columns(k_a)
kcol = psi_bilinear_matrix_columns(k_a) ! Index of beta part of determinant k_a
ASSERT (kcol <= N_det_beta_unique)
tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow)
@ -278,6 +278,8 @@ compute_singles=.True.
endif
kcol_prev = kcol
! -> Here, tmp_det is determinant k_a
! Loop over singly excited beta columns
! -------------------------------------
@ -287,11 +289,23 @@ compute_singles=.True.
tmp_det2(1:$N_int,2) = psi_det_beta_unique(1:$N_int, lcol)
! tmp_det2 is a single excitation of tmp_det in the beta spin
! the alpha part is not defined yet
!---
! if (compute_singles) then
l_a = psi_bilinear_matrix_columns_loc(lcol)
ASSERT (l_a <= N_det)
! rows : | 1 2 3 4 | 1 3 4 6 | .... | 1 2 4 5 |
! cols : | 1 1 1 1 | 2 2 2 2 | .... | 8 8 8 8 |
! index : | 1 2 3 4 | 5 6 7 8 | .... | 58 59 60 61 |
! ^ ^
! | |
! l_a N_det
! l_a is the index in the big vector os size Ndet of the position of the first element of column lcol
! Below we identify all the determinants with the same beta part
!DIR$ UNROLL(8)
!DIR$ LOOP COUNT avg(50000)
@ -307,6 +321,8 @@ compute_singles=.True.
enddo
j = j-1
! Get all single excitations from tmp_det(1,1) to buffer(1,?)
call get_all_spin_singles_$N_int( &
buffer, idx, tmp_det(1,1), j, &
singles_a, n_singles_a )
@ -413,6 +429,7 @@ compute_singles=.True.
ASSERT (lrow <= N_det_alpha_unique)
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
! call i_H_j( tmp_det, tmp_det2, $N_int, hij)
call i_H_j_double_alpha_beta(tmp_det,tmp_det2,$N_int,hij)
!DIR$ LOOP COUNT AVG(4)
do l=1,N_st
@ -558,7 +575,10 @@ compute_singles=.True.
lrow = psi_bilinear_matrix_rows(l_a)
ASSERT (lrow <= N_det_alpha_unique)
! tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int, lrow)
! call i_H_j( tmp_det, tmp_det2, $N_int, hij)
call i_H_j_double_spin( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij)
!DIR$ LOOP COUNT AVG(4)
do l=1,N_st
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
@ -650,7 +670,7 @@ compute_singles=.True.
ASSERT (lcol <= N_det_beta_unique)
tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol)
call i_h_j_single_spin( tmp_det, tmp_det2, $N_int, 2, hij)
call i_H_j_single_spin( tmp_det, tmp_det2, $N_int, 2, hij)
!DIR$ LOOP COUNT AVG(4)
do l=1,N_st
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
@ -696,6 +716,8 @@ compute_singles=.True.
lcol = psi_bilinear_matrix_transp_columns(l_b)
ASSERT (lcol <= N_det_beta_unique)
! tmp_det2(1:N_int,2) = psi_det_beta_unique(1:N_int, lcol)
! call i_H_j( tmp_det, tmp_det2, $N_int, hij)
call i_H_j_double_spin( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij)
!DIR$ LOOP COUNT AVG(4)

View File

@ -262,11 +262,11 @@ subroutine set_natural_mos
iorb = list_virt(i)
do j = 1, n_core_inact_act_orb
jorb = list_core_inact_act(j)
if(one_e_dm_mo(iorb,jorb).ne. 0.d0)then
print*,'AHAHAH'
print*,iorb,jorb,one_e_dm_mo(iorb,jorb)
stop
endif
! if(one_e_dm_mo(iorb,jorb).ne. 0.d0)then
! print*,'AHAHAH'
! print*,iorb,jorb,one_e_dm_mo(iorb,jorb)
! stop
! endif
enddo
enddo
call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label)

View File

@ -54,12 +54,27 @@ END_PROVIDER
subroutine print_dipole_moments
implicit none
BEGIN_DOC
! Print dipole moments nicely
END_DOC
integer :: i
print*, ''
print*, ''
print*, '****************************************'
write(*,'(A10)',advance='no') ' State : '
do i = 1,N_states
write(*,'(i16)',advance='no') i
end do
write(*,*) ''
write(*,'(A23,100(1pE16.8))') 'x_dipole_moment (au) = ',x_dipole_moment
write(*,'(A23,100(1pE16.8))') 'y_dipole_moment (au) = ',y_dipole_moment
write(*,'(A23,100(1pE16.8))') 'z_dipole_moment (au) = ',z_dipole_moment
write(*,*) ''
write(*,'(A23,100(1pE16.8))') 'x_dipole_moment (D) = ',x_dipole_moment * au_to_D
write(*,'(A23,100(1pE16.8))') 'y_dipole_moment (D) = ',y_dipole_moment * au_to_D
write(*,'(A23,100(1pE16.8))') 'z_dipole_moment (D) = ',z_dipole_moment * au_to_D
print*, '****************************************'
end
subroutine print_z_dipole_moment_only
implicit none
print*, ''
print*, ''
print*, '****************************************'
print*, 'z_dipole_moment = ',z_dipole_moment
print*, '****************************************'
end

View File

@ -247,7 +247,7 @@ subroutine add_integrals_to_map(mask_ijkl)
call wall_time(wall_1)
size_buffer = min(mo_num*mo_num*mo_num,8000000)
size_buffer = min(ao_num*ao_num*ao_num,8000000)
print*, 'Buffers : ', 8.*(mo_num*(n_j)*(n_k+1) + mo_num+&
ao_num+ao_num*ao_num+ size_buffer*3)/(1024*1024), 'MB / core'

View File

@ -2,6 +2,6 @@ program print_dipole
implicit none
read_wf = .True.
SOFT_TOUCH read_wf
call print_z_dipole_moment_only
call print_dipole_moments
end