10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-27 23:52:24 +02:00
QuantumPackage/src/two_body_rdm/state_av_act_2rdm.irp.f

98 lines
3.9 KiB
Fortran
Raw Normal View History

2020-03-19 15:57:49 +01:00
2020-03-22 17:21:49 +01:00
BEGIN_PROVIDER [double precision, state_av_act_2_rdm_aa_mo, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
2020-03-19 15:57:49 +01:00
implicit none
double precision, allocatable :: state_weights(:)
BEGIN_DOC
2020-03-22 17:21:49 +01:00
! state_av_act_2_rdm_aa_mo(i,j,k,l) = state average physicist two-body rdm restricted to the ACTIVE indices for alpha-alpha electron pairs
2020-03-19 15:57:49 +01:00
! = <Psi| a^{\dagger}_i a^{\dagger}_j a_l a_k |Psi>
END_DOC
allocate(state_weights(N_states))
state_weights = state_average_weight
integer :: ispin
! condition for alpha/beta spin
ispin = 1
2020-03-22 17:21:49 +01:00
state_av_act_2_rdm_aa_mo = 0.D0
call wall_time(wall_1)
double precision :: wall_1, wall_2
2020-03-22 17:21:49 +01:00
call orb_range_2_rdm_state_av_openmp(state_av_act_2_rdm_aa_mo,n_act_orb,n_act_orb,list_act,state_weights,ispin,psi_coef,size(psi_coef,2),size(psi_coef,1))
call wall_time(wall_2)
2020-03-22 17:21:49 +01:00
print*,'Wall time to provide state_av_act_2_rdm_aa_mo',wall_2 - wall_1
2020-03-19 15:57:49 +01:00
END_PROVIDER
2020-03-22 17:21:49 +01:00
BEGIN_PROVIDER [double precision, state_av_act_2_rdm_bb_mo, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
2020-03-19 15:57:49 +01:00
implicit none
double precision, allocatable :: state_weights(:)
BEGIN_DOC
2020-03-22 17:21:49 +01:00
! state_av_act_2_rdm_bb_mo(i,j,k,l) = state average physicist two-body rdm restricted to the ACTIVE indices for beta-beta electron pairs
2020-03-19 15:57:49 +01:00
! = <Psi| a^{\dagger}_i a^{\dagger}_j a_l a_k |Psi>
END_DOC
allocate(state_weights(N_states))
state_weights = state_average_weight
integer :: ispin
! condition for alpha/beta spin
ispin = 2
2020-03-22 17:21:49 +01:00
state_av_act_2_rdm_bb_mo = 0.d0
call wall_time(wall_1)
double precision :: wall_1, wall_2
2020-03-22 17:21:49 +01:00
call orb_range_2_rdm_state_av_openmp(state_av_act_2_rdm_bb_mo,n_act_orb,n_act_orb,list_act,state_weights,ispin,psi_coef,size(psi_coef,2),size(psi_coef,1))
call wall_time(wall_2)
2020-03-22 17:21:49 +01:00
print*,'Wall time to provide state_av_act_2_rdm_bb_mo',wall_2 - wall_1
2020-03-19 15:57:49 +01:00
END_PROVIDER
2020-03-22 17:21:49 +01:00
BEGIN_PROVIDER [double precision, state_av_act_2_rdm_ab_mo, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
2020-03-19 15:57:49 +01:00
implicit none
double precision, allocatable :: state_weights(:)
BEGIN_DOC
2020-03-22 17:21:49 +01:00
! state_av_act_2_rdm_ab_mo(i,j,k,l) = state average physicist two-body rdm restricted to the ACTIVE indices for alpha-beta electron pairs
2020-03-19 15:57:49 +01:00
! = <Psi| a^{\dagger}_{i,alpha} a^{\dagger}_{j,beta} a_{l,beta} a_{k,alpha} |Psi>
END_DOC
allocate(state_weights(N_states))
state_weights = state_average_weight
integer :: ispin
! condition for alpha/beta spin
print*,''
print*,''
print*,''
2020-03-22 17:21:49 +01:00
print*,'providint state_av_act_2_rdm_ab_mo '
2020-03-19 15:57:49 +01:00
ispin = 3
print*,'ispin = ',ispin
2020-03-22 17:21:49 +01:00
state_av_act_2_rdm_ab_mo = 0.d0
call wall_time(wall_1)
double precision :: wall_1, wall_2
2020-03-22 17:21:49 +01:00
call orb_range_2_rdm_state_av_openmp(state_av_act_2_rdm_ab_mo,n_act_orb,n_act_orb,list_act,state_weights,ispin,psi_coef,size(psi_coef,2),size(psi_coef,1))
call wall_time(wall_2)
2020-03-22 17:21:49 +01:00
print*,'Wall time to provide state_av_act_2_rdm_ab_mo',wall_2 - wall_1
2020-03-19 15:57:49 +01:00
END_PROVIDER
2020-03-22 17:21:49 +01:00
BEGIN_PROVIDER [double precision, state_av_act_2_rdm_spin_trace_mo, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
2020-03-19 15:57:49 +01:00
implicit none
BEGIN_DOC
2020-03-22 17:21:49 +01:00
! state_av_act_2_rdm_spin_trace_mo(i,j,k,l) = state average physicist spin trace two-body rdm restricted to the ACTIVE indices
2020-03-19 15:57:49 +01:00
! The active part of the two-electron energy can be computed as:
!
2020-03-22 17:21:49 +01:00
! \sum_{i,j,k,l = 1, n_act_orb} state_av_act_2_rdm_spin_trace_mo(i,j,k,l) * < ii jj | kk ll >
2020-03-19 15:57:49 +01:00
!
! with ii = list_act(i), jj = list_act(j), kk = list_act(k), ll = list_act(l)
END_DOC
double precision, allocatable :: state_weights(:)
allocate(state_weights(N_states))
state_weights = state_average_weight
integer :: ispin
! condition for alpha/beta spin
ispin = 4
2020-03-22 17:21:49 +01:00
state_av_act_2_rdm_spin_trace_mo = 0.d0
2020-03-19 15:57:49 +01:00
integer :: i
call wall_time(wall_1)
double precision :: wall_1, wall_2
2020-03-22 17:21:49 +01:00
print*,'providing state_av_act_2_rdm_spin_trace_mo '
call orb_range_2_rdm_state_av_openmp(state_av_act_2_rdm_spin_trace_mo,n_act_orb,n_act_orb,list_act,state_weights,ispin,psi_coef,size(psi_coef,2),size(psi_coef,1))
2020-03-19 15:57:49 +01:00
call wall_time(wall_2)
2020-03-22 17:21:49 +01:00
print*,'Time to provide state_av_act_2_rdm_spin_trace_mo',wall_2 - wall_1
2020-03-19 15:57:49 +01:00
END_PROVIDER