10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-23 04:43:45 +01:00

all states 2rdm work

This commit is contained in:
Emmanuel Giner LCT 2019-07-02 08:55:51 +02:00
parent 7df2c2a20c
commit c6e59030de

View File

@ -244,12 +244,12 @@ subroutine orb_range_all_states_two_rdm_openmp_work_$N_int(big_array,dim1,norb,l
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
c_contrib = 0.d0 c_contrib = 0.d0
do l= 1, N_states do l= 1, N_st
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)
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_ab_dm(tmp_det,tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin) call orb_range_off_diagonal_double_to_two_rdm_ab_dm_all_states(tmp_det,tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
enddo enddo
endif endif
@ -319,16 +319,16 @@ subroutine orb_range_all_states_two_rdm_openmp_work_$N_int(big_array,dim1,norb,l
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
c_contrib = 0.d0 c_contrib = 0.d0
do l= 1, N_states do l= 1, N_st
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)
c_contrib(l) = c_1(l) * c_2(l) c_contrib(l) = c_1(l) * c_2(l)
enddo enddo
if(alpha_beta.or.spin_trace.or.alpha_alpha)then if(alpha_beta.or.spin_trace.or.alpha_alpha)then
! increment the alpha/beta part for single excitations ! increment the alpha/beta part for single excitations
call orb_range_off_diagonal_single_to_two_rdm_ab_dm(tmp_det, tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin) call orb_range_off_diagonal_single_to_two_rdm_ab_dm_all_states(tmp_det, tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
! increment the alpha/alpha part for single excitations ! increment the alpha/alpha part for single excitations
call orb_range_off_diagonal_single_to_two_rdm_aa_dm(tmp_det,tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin) call orb_range_off_diagonal_single_to_two_rdm_aa_dm_all_states(tmp_det,tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
endif endif
enddo enddo
@ -346,12 +346,12 @@ subroutine orb_range_all_states_two_rdm_openmp_work_$N_int(big_array,dim1,norb,l
ASSERT (lrow <= N_det_alpha_unique) ASSERT (lrow <= N_det_alpha_unique)
c_contrib = 0.d0 c_contrib = 0.d0
do l= 1, N_states do l= 1, N_st
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)
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_aa_dm(tmp_det(1,1),psi_det_alpha_unique(1, lrow),c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin) call orb_range_off_diagonal_double_to_two_rdm_aa_dm_all_states(tmp_det(1,1),psi_det_alpha_unique(1, lrow),c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
enddo enddo
endif endif
@ -411,16 +411,16 @@ subroutine orb_range_all_states_two_rdm_openmp_work_$N_int(big_array,dim1,norb,l
tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol)
l_a = psi_bilinear_matrix_transp_order(l_b) l_a = psi_bilinear_matrix_transp_order(l_b)
c_contrib = 0.d0 c_contrib = 0.d0
do l= 1, N_states do l= 1, N_st
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)
c_contrib(l) = c_1(l) * c_2(l) c_contrib(l) = c_1(l) * c_2(l)
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
call orb_range_off_diagonal_single_to_two_rdm_ab_dm(tmp_det, tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin) call orb_range_off_diagonal_single_to_two_rdm_ab_dm_all_states(tmp_det, tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
! increment the beta /beta part for single excitations ! increment the beta /beta part for single excitations
call orb_range_off_diagonal_single_to_two_rdm_bb_dm(tmp_det, tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin) call orb_range_off_diagonal_single_to_two_rdm_bb_dm_all_states(tmp_det, tmp_det2,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
endif endif
enddo enddo
@ -437,12 +437,12 @@ subroutine orb_range_all_states_two_rdm_openmp_work_$N_int(big_array,dim1,norb,l
l_a = psi_bilinear_matrix_transp_order(l_b) l_a = psi_bilinear_matrix_transp_order(l_b)
c_contrib = 0.d0 c_contrib = 0.d0
do l= 1, N_states do l= 1, N_st
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)
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(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_alpha_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
@ -469,12 +469,12 @@ subroutine orb_range_all_states_two_rdm_openmp_work_$N_int(big_array,dim1,norb,l
double precision :: c_1(N_states),c_2(N_states) double precision :: c_1(N_states),c_2(N_states)
c_contrib = 0.d0 c_contrib = 0.d0
do l = 1, N_states do l = 1, N_st
c_1(l) = u_t(l,k_a) c_1(l) = u_t(l,k_a)
c_contrib(l) += c_1(l) * c_1(l) c_contrib(l) = c_1(l) * c_1(l)
enddo enddo
call orb_range_diagonal_contrib_to_all_two_rdm_dm(tmp_det,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin) call orb_range_diagonal_contrib_to_all_two_rdm_dm_all_states(tmp_det,c_contrib,N_st,big_array,dim1,orb_bitmask,list_orb_reverse,ispin)
end do end do
!!$OMP END DO !!$OMP END DO