mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-03 20:53:54 +01:00
bypass one_e_tr_dm_mo for large mo_num & n_states
This commit is contained in:
AbdAmmar
parent
6e2f28b97f
commit
29da3b6542
@ -18,7 +18,7 @@
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [double precision, multi_s_dipole_moment, (N_states, N_states)]
|
||||
BEGIN_PROVIDER [double precision, multi_s_dipole_moment , (N_states, N_states)]
|
||||
&BEGIN_PROVIDER [double precision, multi_s_x_dipole_moment, (N_states, N_states)]
|
||||
&BEGIN_PROVIDER [double precision, multi_s_y_dipole_moment, (N_states, N_states)]
|
||||
&BEGIN_PROVIDER [double precision, multi_s_z_dipole_moment, (N_states, N_states)]
|
||||
@ -40,17 +40,18 @@ BEGIN_PROVIDER [double precision, multi_s_dipole_moment, (N_states, N_states)]
|
||||
! gamma^{nm}: density matrix \bra{\Psi^n} a^{\dagger}_a a_i \ket{\Psi^m}
|
||||
END_DOC
|
||||
|
||||
integer :: istate,jstate ! States
|
||||
integer :: i,j ! general spatial MOs
|
||||
integer :: istate, jstate ! States
|
||||
integer :: i, j ! general spatial MOs
|
||||
double precision :: nuclei_part_x, nuclei_part_y, nuclei_part_z
|
||||
|
||||
multi_s_x_dipole_moment = 0.d0
|
||||
multi_s_y_dipole_moment = 0.d0
|
||||
multi_s_z_dipole_moment = 0.d0
|
||||
|
||||
if(8.d0*mo_num*mo_num*n_states*n_states*1d-9 .lt. 200.d0) then
|
||||
|
||||
do jstate = 1, N_states
|
||||
do istate = 1, N_states
|
||||
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
multi_s_x_dipole_moment(istate,jstate) -= one_e_tr_dm_mo(j,i,istate,jstate) * mo_dipole_x(j,i)
|
||||
@ -58,9 +59,134 @@ BEGIN_PROVIDER [double precision, multi_s_dipole_moment, (N_states, N_states)]
|
||||
multi_s_z_dipole_moment(istate,jstate) -= one_e_tr_dm_mo(j,i,istate,jstate) * mo_dipole_z(j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
! no enouph memory
|
||||
! on the fly scheme
|
||||
|
||||
PROVIDE psi_det_alpha_unique psi_det_beta_unique
|
||||
|
||||
integer :: l, k_a, k_b
|
||||
integer :: occ(N_int*bit_kind_size,2)
|
||||
integer :: h1, h2, p1, p2, degree
|
||||
integer :: exc(0:2,2), n_occ(2)
|
||||
integer :: krow, kcol, lrow, lcol
|
||||
integer(bit_kind) :: tmp_det(N_int,2), tmp_det2(N_int)
|
||||
double precision :: ck, ckl, phase
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j, l, k_a, k_b, istate, jstate, occ, ck, ckl, h1, h2, p1, p2, exc, &
|
||||
!$OMP phase, degree, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2) &
|
||||
!$OMP SHARED(N_int, N_states, elec_alpha_num, elec_beta_num, N_det, &
|
||||
!$OMP psi_bilinear_matrix_rows, psi_bilinear_matrix_columns, &
|
||||
!$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns, &
|
||||
!$OMP psi_det_alpha_unique, psi_det_beta_unique, &
|
||||
!$OMP psi_bilinear_matrix_values, psi_bilinear_matrix_transp_values, &
|
||||
!$OMP mo_dipole_x, mo_dipole_y, mo_dipole_z, &
|
||||
!$OMP multi_s_x_dipole_moment, multi_s_y_dipole_moment, multi_s_z_dipole_moment)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do istate = 1, N_states
|
||||
do jstate = 1, N_states
|
||||
|
||||
do k_a = 1, N_det
|
||||
krow = psi_bilinear_matrix_rows (k_a)
|
||||
kcol = psi_bilinear_matrix_columns(k_a)
|
||||
|
||||
tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow)
|
||||
tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol)
|
||||
|
||||
! Diagonal part
|
||||
call bitstring_to_list_ab(tmp_det, occ, n_occ, N_int)
|
||||
ck = psi_bilinear_matrix_values(k_a,istate)*psi_bilinear_matrix_values(k_a,jstate)
|
||||
do l = 1, elec_alpha_num
|
||||
j = occ(l,1)
|
||||
multi_s_x_dipole_moment(istate,jstate) -= ck * mo_dipole_x(j,j)
|
||||
multi_s_y_dipole_moment(istate,jstate) -= ck * mo_dipole_y(j,j)
|
||||
multi_s_z_dipole_moment(istate,jstate) -= ck * mo_dipole_z(j,j)
|
||||
enddo
|
||||
|
||||
if (k_a == N_det) cycle
|
||||
l = k_a + 1
|
||||
lrow = psi_bilinear_matrix_rows (l)
|
||||
lcol = psi_bilinear_matrix_columns(l)
|
||||
! Fix beta determinant, loop over alphas
|
||||
do while (lcol == kcol)
|
||||
tmp_det2(:) = psi_det_alpha_unique(:,lrow)
|
||||
call get_excitation_degree_spin(tmp_det(1,1), tmp_det2, degree, N_int)
|
||||
if (degree == 1) then
|
||||
exc = 0
|
||||
call get_single_excitation_spin(tmp_det(1,1), tmp_det2, exc, phase, N_int)
|
||||
call decode_exc_spin(exc, h1, p1, h2, p2)
|
||||
ckl = psi_bilinear_matrix_values(k_a,istate)*psi_bilinear_matrix_values(l,jstate) * phase
|
||||
multi_s_x_dipole_moment(istate,jstate) -= ckl * mo_dipole_x(h1,p1)
|
||||
multi_s_y_dipole_moment(istate,jstate) -= ckl * mo_dipole_y(h1,p1)
|
||||
multi_s_z_dipole_moment(istate,jstate) -= ckl * mo_dipole_z(h1,p1)
|
||||
ckl = psi_bilinear_matrix_values(k_a,jstate)*psi_bilinear_matrix_values(l,istate) * phase
|
||||
multi_s_x_dipole_moment(istate,jstate) -= ckl * mo_dipole_x(p1,h1)
|
||||
multi_s_y_dipole_moment(istate,jstate) -= ckl * mo_dipole_y(p1,h1)
|
||||
multi_s_z_dipole_moment(istate,jstate) -= ckl * mo_dipole_z(p1,h1)
|
||||
endif
|
||||
l = l+1
|
||||
if (l > N_det) exit
|
||||
lrow = psi_bilinear_matrix_rows (l)
|
||||
lcol = psi_bilinear_matrix_columns(l)
|
||||
enddo
|
||||
enddo ! k_a
|
||||
|
||||
do k_b = 1, N_det
|
||||
krow = psi_bilinear_matrix_transp_rows (k_b)
|
||||
kcol = psi_bilinear_matrix_transp_columns(k_b)
|
||||
|
||||
tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow)
|
||||
tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol)
|
||||
|
||||
! Diagonal part
|
||||
call bitstring_to_list_ab(tmp_det, occ, n_occ, N_int)
|
||||
ck = psi_bilinear_matrix_transp_values(k_b,istate)*psi_bilinear_matrix_transp_values(k_b,jstate)
|
||||
do l = 1, elec_beta_num
|
||||
j = occ(l,2)
|
||||
multi_s_x_dipole_moment(istate,jstate) -= ck * mo_dipole_x(j,j)
|
||||
multi_s_y_dipole_moment(istate,jstate) -= ck * mo_dipole_y(j,j)
|
||||
multi_s_z_dipole_moment(istate,jstate) -= ck * mo_dipole_z(j,j)
|
||||
enddo
|
||||
|
||||
if (k_b == N_det) cycle
|
||||
l = k_b+1
|
||||
lrow = psi_bilinear_matrix_transp_rows (l)
|
||||
lcol = psi_bilinear_matrix_transp_columns(l)
|
||||
! Fix beta determinant, loop over alphas
|
||||
do while (lrow == krow)
|
||||
tmp_det2(:) = psi_det_beta_unique(:,lcol)
|
||||
call get_excitation_degree_spin(tmp_det(1,2), tmp_det2, degree, N_int)
|
||||
if (degree == 1) then
|
||||
exc = 0
|
||||
call get_single_excitation_spin(tmp_det(1,2), tmp_det2, exc, phase, N_int)
|
||||
call decode_exc_spin(exc, h1, p1, h2, p2)
|
||||
ckl = psi_bilinear_matrix_transp_values(k_b,istate)*psi_bilinear_matrix_transp_values(l,jstate) * phase
|
||||
multi_s_x_dipole_moment(istate,jstate) -= ckl * mo_dipole_x(h1,p1)
|
||||
multi_s_y_dipole_moment(istate,jstate) -= ckl * mo_dipole_y(h1,p1)
|
||||
multi_s_z_dipole_moment(istate,jstate) -= ckl * mo_dipole_z(h1,p1)
|
||||
ckl = psi_bilinear_matrix_transp_values(k_b,jstate)*psi_bilinear_matrix_transp_values(l,istate) * phase
|
||||
multi_s_x_dipole_moment(istate,jstate) -= ckl * mo_dipole_x(p1,h1)
|
||||
multi_s_y_dipole_moment(istate,jstate) -= ckl * mo_dipole_y(p1,h1)
|
||||
multi_s_z_dipole_moment(istate,jstate) -= ckl * mo_dipole_z(p1,h1)
|
||||
endif
|
||||
l = l+1
|
||||
if (l > N_det) exit
|
||||
lrow = psi_bilinear_matrix_transp_rows (l)
|
||||
lcol = psi_bilinear_matrix_transp_columns(l)
|
||||
enddo
|
||||
enddo ! k_b
|
||||
|
||||
enddo ! istate
|
||||
enddo ! jstate
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
endif ! memory condition
|
||||
|
||||
! Nuclei part
|
||||
nuclei_part_x = 0.d0
|
||||
|
||||
Loading…
Reference in New Issue
Block a user