mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-09-01 13:43:40 +02:00
This commit is contained in:
parent
030dc9acf6
commit
8a52b46b48
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -54,12 +54,27 @@ END_PROVIDER
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine print_z_dipole_moment_only
|
||||
subroutine print_dipole_moments
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Print dipole moments nicely
|
||||
END_DOC
|
||||
integer :: i
|
||||
print*, ''
|
||||
print*, ''
|
||||
print*, '****************************************'
|
||||
print*, 'z_dipole_moment = ',z_dipole_moment
|
||||
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
|
||||
|
||||
|
@ -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'
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user