mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-21 19:13:29 +01:00
bug fixed in openmp 2 rdms
This commit is contained in:
parent
887afe97b4
commit
e3779e3c63
@ -392,7 +392,7 @@ subroutine all_two_rdm_dm_nstates_work_$N_int(big_array_aa,big_array_bb,big_arra
|
|||||||
c_1(l) = u_t(l,l_a)
|
c_1(l) = u_t(l,l_a)
|
||||||
c_2(l) = u_t(l,k_a)
|
c_2(l) = u_t(l,k_a)
|
||||||
enddo
|
enddo
|
||||||
call off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_alpha_unique(1, lcol),c_1,c_2,big_array_bb,dim1,dim2,dim3,dim4)
|
call off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_beta_unique(1, lcol),c_1,c_2,big_array_bb,dim1,dim2,dim3,dim4)
|
||||||
ASSERT (l_a <= N_det)
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
@ -442,7 +442,7 @@ subroutine orb_range_all_states_two_rdm_work_$N_int(big_array,dim1,norb,list_orb
|
|||||||
c_2(l) = u_t(l,k_a)
|
c_2(l) = u_t(l,k_a)
|
||||||
c_contrib(l) = c_1(l) * c_2(l)
|
c_contrib(l) = c_1(l) * c_2(l)
|
||||||
enddo
|
enddo
|
||||||
call orb_range_off_diagonal_double_to_two_rdm_bb_dm_all_states(tmp_det(1,2),psi_det_alpha_unique(1, lcol),c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
|
call orb_range_off_diagonal_double_to_two_rdm_bb_dm_all_states(tmp_det(1,2),psi_det_beta_unique(1, lcol),c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
|
||||||
ASSERT (l_a <= N_det)
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
@ -445,7 +445,7 @@ subroutine orb_range_two_rdm_state_av_work_$N_int(big_array,dim1,norb,list_orb,l
|
|||||||
c_2(l) = u_t(l,k_a)
|
c_2(l) = u_t(l,k_a)
|
||||||
c_average += c_1(l) * c_2(l) * state_weights(l)
|
c_average += c_1(l) * c_2(l) * state_weights(l)
|
||||||
enddo
|
enddo
|
||||||
call orb_range_off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_alpha_unique(1, lcol),c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
|
call orb_range_off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_beta_unique(1, lcol),c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
|
||||||
ASSERT (l_a <= N_det)
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
@ -93,11 +93,9 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
|
|||||||
double precision, intent(inout) :: big_array(dim1,dim1,dim1,dim1)
|
double precision, intent(inout) :: big_array(dim1,dim1,dim1,dim1)
|
||||||
|
|
||||||
integer :: i,j,k,l
|
integer :: i,j,k,l
|
||||||
integer :: k_a, k_b, l_a, l_b, m_a, m_b
|
integer :: k_a, k_b, l_a, l_b
|
||||||
integer :: istate
|
integer :: krow, kcol
|
||||||
integer :: krow, kcol, krow_b, kcol_b
|
|
||||||
integer :: lrow, lcol
|
integer :: lrow, lcol
|
||||||
integer :: mrow, mcol
|
|
||||||
integer(bit_kind) :: spindet($N_int)
|
integer(bit_kind) :: spindet($N_int)
|
||||||
integer(bit_kind) :: tmp_det($N_int,2)
|
integer(bit_kind) :: tmp_det($N_int,2)
|
||||||
integer(bit_kind) :: tmp_det2($N_int,2)
|
integer(bit_kind) :: tmp_det2($N_int,2)
|
||||||
@ -109,7 +107,6 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
|
|||||||
integer, allocatable :: singles_b(:)
|
integer, allocatable :: singles_b(:)
|
||||||
integer, allocatable :: idx(:), idx0(:)
|
integer, allocatable :: idx(:), idx0(:)
|
||||||
integer :: maxab, n_singles_a, n_singles_b, kcol_prev
|
integer :: maxab, n_singles_a, n_singles_b, kcol_prev
|
||||||
integer*8 :: k8
|
|
||||||
double precision :: c_average
|
double precision :: c_average
|
||||||
|
|
||||||
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
|
logical :: alpha_alpha,beta_beta,alpha_beta,spin_trace
|
||||||
@ -136,11 +133,6 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
|
|||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
|
|
||||||
!do i = 1, N_int
|
|
||||||
! det_1_act(i,1) = iand(det_1(i,1),orb_bitmask(i))
|
|
||||||
! det_1_act(i,2) = iand(det_1(i,2),orb_bitmask(i))
|
|
||||||
!enddo
|
|
||||||
|
|
||||||
|
|
||||||
PROVIDE N_int
|
PROVIDE N_int
|
||||||
|
|
||||||
@ -173,13 +165,13 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
|
|||||||
! !$OMP psi_bilinear_matrix_columns_loc, &
|
! !$OMP psi_bilinear_matrix_columns_loc, &
|
||||||
! !$OMP psi_bilinear_matrix_transp_rows_loc, &
|
! !$OMP psi_bilinear_matrix_transp_rows_loc, &
|
||||||
! !$OMP istart, iend, istep, irp_here, v_t, s_t, &
|
! !$OMP istart, iend, istep, irp_here, v_t, s_t, &
|
||||||
! !$OMP ishift, idx0, u_t, maxab) &
|
! !$OMP ishift, idx0, u_t, maxab, alpha_alpha,beta_beta,alpha_beta,spin_trace,ispin) &
|
||||||
! !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i,&
|
! !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i,&
|
||||||
! !$OMP lcol, lrow, l_a, l_b, &
|
! !$OMP lcol, lrow, l_a, l_b, &
|
||||||
! !$OMP buffer, doubles, n_doubles, &
|
! !$OMP buffer, doubles, n_doubles, &
|
||||||
! !$OMP tmp_det2, idx, l, kcol_prev, &
|
! !$OMP tmp_det2, idx, l, kcol_prev, &
|
||||||
! !$OMP singles_a, n_singles_a, singles_b, &
|
! !$OMP singles_a, n_singles_a, singles_b, &
|
||||||
! !$OMP n_singles_b, k8)
|
! !$OMP n_singles_b, nkeys, keys, valus, c_average)
|
||||||
|
|
||||||
! Alpha/Beta double excitations
|
! Alpha/Beta double excitations
|
||||||
! =============================
|
! =============================
|
||||||
@ -359,7 +351,7 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
|
|||||||
endif
|
endif
|
||||||
call orb_range_off_diag_single_to_two_rdm_ab_dm_buffer(tmp_det, tmp_det2,c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
|
call orb_range_off_diag_single_to_two_rdm_ab_dm_buffer(tmp_det, tmp_det2,c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
|
||||||
! increment the alpha/alpha part for single excitations
|
! increment the alpha/alpha part for single excitations
|
||||||
if (nkeys+2 * norb .ge. size(values)) then
|
if (nkeys+4 * norb .ge. size(values)) then
|
||||||
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
|
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
|
||||||
nkeys = 0
|
nkeys = 0
|
||||||
endif
|
endif
|
||||||
@ -457,13 +449,13 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
|
|||||||
enddo
|
enddo
|
||||||
if(alpha_beta.or.spin_trace.or.beta_beta)then
|
if(alpha_beta.or.spin_trace.or.beta_beta)then
|
||||||
! increment the alpha/beta part for single excitations
|
! increment the alpha/beta part for single excitations
|
||||||
if (nkeys+norb .ge. size(values)) then
|
if (nkeys+2 * norb .ge. size(values)) then
|
||||||
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
|
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
|
||||||
nkeys = 0
|
nkeys = 0
|
||||||
endif
|
endif
|
||||||
call orb_range_off_diag_single_to_two_rdm_ab_dm_buffer(tmp_det, tmp_det2,c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
|
call orb_range_off_diag_single_to_two_rdm_ab_dm_buffer(tmp_det, tmp_det2,c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
|
||||||
! increment the beta /beta part for single excitations
|
! increment the beta /beta part for single excitations
|
||||||
if (nkeys+norb .ge. size(values)) then
|
if (nkeys+4 * norb .ge. size(values)) then
|
||||||
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
|
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
|
||||||
nkeys = 0
|
nkeys = 0
|
||||||
endif
|
endif
|
||||||
@ -489,12 +481,11 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
|
|||||||
c_2(l) = u_t(l,k_a)
|
c_2(l) = u_t(l,k_a)
|
||||||
c_average += c_1(l) * c_2(l) * state_weights(l)
|
c_average += c_1(l) * c_2(l) * state_weights(l)
|
||||||
enddo
|
enddo
|
||||||
! call orb_range_off_diagonal_double_to_two_rdm_bb_dm(tmp_det(1,2),psi_det_alpha_unique(1, lcol),c_average,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
|
|
||||||
if (nkeys+4 .ge. size(values)) then
|
if (nkeys+4 .ge. size(values)) then
|
||||||
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
|
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
|
||||||
nkeys = 0
|
nkeys = 0
|
||||||
endif
|
endif
|
||||||
call orb_range_off_diag_double_to_two_rdm_bb_dm_buffer(tmp_det(1,2),psi_det_alpha_unique(1, lcol),c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
|
call orb_range_off_diag_double_to_two_rdm_bb_dm_buffer(tmp_det(1,2),psi_det_beta_unique(1, lcol),c_average,list_orb_reverse,ispin,sze_buff,nkeys,keys,values)
|
||||||
ASSERT (l_a <= N_det)
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
@ -534,7 +525,7 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
|
|||||||
|
|
||||||
end do
|
end do
|
||||||
!!$OMP END DO
|
!!$OMP END DO
|
||||||
deallocate(buffer, singles_a, singles_b, doubles, idx)
|
deallocate(buffer, singles_a, singles_b, doubles, idx, keys, values)
|
||||||
!!$OMP END PARALLEL
|
!!$OMP END PARALLEL
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -639,7 +639,7 @@
|
|||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
implicit none
|
||||||
integer, intent(in) :: ispin,sze_buff
|
integer, intent(in) :: ispin,sze_buff
|
||||||
integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2)
|
integer(bit_kind), intent(in) :: det_1(N_int),det_2(N_int)
|
||||||
integer, intent(in) :: list_orb_reverse(mo_num)
|
integer, intent(in) :: list_orb_reverse(mo_num)
|
||||||
double precision, intent(in) :: c_1
|
double precision, intent(in) :: c_1
|
||||||
double precision, intent(out) :: values(sze_buff)
|
double precision, intent(out) :: values(sze_buff)
|
||||||
@ -735,7 +735,7 @@
|
|||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer, intent(in) :: ispin,sze_buff
|
integer, intent(in) :: ispin,sze_buff
|
||||||
integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2)
|
integer(bit_kind), intent(in) :: det_1(N_int),det_2(N_int)
|
||||||
integer, intent(in) :: list_orb_reverse(mo_num)
|
integer, intent(in) :: list_orb_reverse(mo_num)
|
||||||
double precision, intent(in) :: c_1
|
double precision, intent(in) :: c_1
|
||||||
double precision, intent(out) :: values(sze_buff)
|
double precision, intent(out) :: values(sze_buff)
|
||||||
|
Loading…
Reference in New Issue
Block a user