diff --git a/src/two_body_rdm/all_2rdm_routines.irp.f b/src/two_body_rdm/all_2rdm_routines.irp.f index 5127e31f..fa036e6a 100644 --- a/src/two_body_rdm/all_2rdm_routines.irp.f +++ b/src/two_body_rdm/all_2rdm_routines.irp.f @@ -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 diff --git a/src/two_body_rdm/all_states_routines.irp.f b/src/two_body_rdm/all_states_routines.irp.f index af7cafc2..8f40f32a 100644 --- a/src/two_body_rdm/all_states_routines.irp.f +++ b/src/two_body_rdm/all_states_routines.irp.f @@ -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 diff --git a/src/two_body_rdm/orb_range_routines.irp.f b/src/two_body_rdm/orb_range_routines.irp.f index d63a0390..a8684185 100644 --- a/src/two_body_rdm/orb_range_routines.irp.f +++ b/src/two_body_rdm/orb_range_routines.irp.f @@ -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 diff --git a/src/two_body_rdm/orb_range_routines_openmp.irp.f b/src/two_body_rdm/orb_range_routines_openmp.irp.f index b4ff7405..ba22e37d 100644 --- a/src/two_body_rdm/orb_range_routines_openmp.irp.f +++ b/src/two_body_rdm/orb_range_routines_openmp.irp.f @@ -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 diff --git a/src/two_body_rdm/routines_compute_2rdm_orb_range_openmp.irp.f b/src/two_body_rdm/routines_compute_2rdm_orb_range_openmp.irp.f index ffbb2711..0ba934d7 100644 --- a/src/two_body_rdm/routines_compute_2rdm_orb_range_openmp.irp.f +++ b/src/two_body_rdm/routines_compute_2rdm_orb_range_openmp.irp.f @@ -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)