9
1
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:
Emmanuel Giner 2019-07-04 18:04:43 +02:00
parent 887afe97b4
commit e3779e3c63
5 changed files with 14 additions and 23 deletions

View File

@ -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_2(l) = u_t(l,k_a)
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)
enddo

View File

@ -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_contrib(l) = c_1(l) * c_2(l)
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)
enddo

View File

@ -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_average += c_1(l) * c_2(l) * state_weights(l)
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)
enddo

View File

@ -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)
integer :: i,j,k,l
integer :: k_a, k_b, l_a, l_b, m_a, m_b
integer :: istate
integer :: krow, kcol, krow_b, kcol_b
integer :: k_a, k_b, l_a, l_b
integer :: krow, kcol
integer :: lrow, lcol
integer :: mrow, mcol
integer(bit_kind) :: spindet($N_int)
integer(bit_kind) :: tmp_det($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 :: idx(:), idx0(:)
integer :: maxab, n_singles_a, n_singles_b, kcol_prev
integer*8 :: k8
double precision :: c_average
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
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
@ -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_transp_rows_loc, &
! !$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 lcol, lrow, l_a, l_b, &
! !$OMP buffer, doubles, n_doubles, &
! !$OMP tmp_det2, idx, l, kcol_prev, &
! !$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
! =============================
@ -359,7 +351,7 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
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)
! 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)
nkeys = 0
endif
@ -457,13 +449,13 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
enddo
if(alpha_beta.or.spin_trace.or.beta_beta)then
! 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)
nkeys = 0
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)
! 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)
nkeys = 0
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_average += c_1(l) * c_2(l) * state_weights(l)
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
call update_keys_values(keys,values,size(values),nkeys,dim1,big_array)
nkeys = 0
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)
enddo
@ -534,7 +525,7 @@ subroutine orb_range_two_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,lis
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
end

View File

@ -639,7 +639,7 @@
END_DOC
implicit none
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)
double precision, intent(in) :: c_1
double precision, intent(out) :: values(sze_buff)
@ -735,7 +735,7 @@
implicit none
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)
double precision, intent(in) :: c_1
double precision, intent(out) :: values(sze_buff)