2019-07-04 16:16:57 +02:00
BEGI N _ PROVIDER [ double precision , state_av_act_two_rdm_openmp_alpha_alp ha_mo, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
impl i cit none
doub l e precision , allocatable :: state_weights ( : )
BEGI N _ DOC
! state_av_act_two_rdm_openmp_alpha_alpha_mo(i,j,k,l) = state average physicist two-body rdm restricted to the ACTIVE indices for alpha-alpha electron pairs
! = <Psi| a^{\dagger}_i a^{\dagger}_j a_l a_k |Psi>
END_ D OC
allo c ate ( state_weights ( N_states ) )
2019-10-25 01:30:30 +02:00
stat e _ weights = state_average_weight
2019-07-04 16:16:57 +02:00
inte g er :: ispin
! condition for alpha/beta spin
ispi n = 1
stat e _ av_act_two_rdm_openmp_alpha_alpha_mo = 0.D0
call orb_range_two_rdm_state_av_openmp ( state_av_act_two_rdm_openmp_alph a_alpha_mo,n_act_orb,n_act_orb,list_act,state_weights,ispin,psi_coef,size(psi_coef,2),size(psi_coef,1))
END_ P ROVIDER
BEGI N _ PROVIDER [ double precision , state_av_act_two_rdm_openmp_beta_beta _mo, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
impl i cit none
doub l e precision , allocatable :: state_weights ( : )
BEGI N _ DOC
! state_av_act_two_rdm_openmp_beta_beta_mo(i,j,k,l) = state average physicist two-body rdm restricted to the ACTIVE indices for beta-beta electron pairs
! = <Psi| a^{\dagger}_i a^{\dagger}_j a_l a_k |Psi>
END_ D OC
allo c ate ( state_weights ( N_states ) )
2019-10-25 01:30:30 +02:00
stat e _ weights = state_average_weight
2019-07-04 16:16:57 +02:00
inte g er :: ispin
! condition for alpha/beta spin
ispi n = 2
stat e _ av_act_two_rdm_openmp_beta_beta_mo = 0.d0
call orb_range_two_rdm_state_av_openmp ( state_av_act_two_rdm_openmp_beta _beta_mo,n_act_orb,n_act_orb,list_act,state_weights,ispin,psi_coef,size(psi_coef,2),size(psi_coef,1))
END_ P ROVIDER
BEGI N _ PROVIDER [ double precision , state_av_act_two_rdm_openmp_alpha_bet a_mo, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
impl i cit none
doub l e precision , allocatable :: state_weights ( : )
BEGI N _ DOC
! state_av_act_two_rdm_openmp_alpha_beta_mo(i,j,k,l) = state average physicist two-body rdm restricted to the ACTIVE indices for alpha-beta electron pairs
! = <Psi| a^{\dagger}_{i,alpha} a^{\dagger}_{j,beta} a_{l,beta} a_{k,alpha} |Psi>
END_ D OC
allo c ate ( state_weights ( N_states ) )
2019-10-25 01:30:30 +02:00
stat e _ weights = state_average_weight
2019-07-04 16:16:57 +02:00
inte g er :: ispin
! condition for alpha/beta spin
prin t * , ''
prin t * , ''
prin t * , ''
prin t * , 'providint state_av_act_two_rdm_openmp_alpha_beta_mo '
ispi n = 3
prin t * , 'ispin = ' , ispin
stat e _ av_act_two_rdm_openmp_alpha_beta_mo = 0.d0
call orb_range_two_rdm_state_av_openmp ( state_av_act_two_rdm_openmp_alph a_beta_mo,n_act_orb,n_act_orb,list_act,state_weights,ispin,psi_coef,size(psi_coef,2),size(psi_coef,1))
END_ P ROVIDER
BEGI N _ PROVIDER [ double precision , state_av_act_two_rdm_openmp_spin_trac e_mo, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
impl i cit none
BEGI N _ DOC
! state_av_act_two_rdm_openmp_spin_trace_mo(i,j,k,l) = state average physicist spin trace two-body rdm restricted to the ACTIVE indices
! The active part of the two-electron energy can be computed as:
!
! \sum_{i,j,k,l = 1, n_act_orb} state_av_act_two_rdm_openmp_spin_trace_mo(i,j,k,l) * < ii jj | kk ll >
!
! with ii = list_act(i), jj = list_act(j), kk = list_act(k), ll = list_act(l)
END_ D OC
doub l e precision , allocatable :: state_weights ( : )
allo c ate ( state_weights ( N_states ) )
2019-10-25 01:30:30 +02:00
stat e _ weights = state_average_weight
2019-07-04 16:16:57 +02:00
inte g er :: ispin
! condition for alpha/beta spin
ispi n = 4
stat e _ av_act_two_rdm_openmp_spin_trace_mo = 0.d0
inte g er :: i
doub l e precision :: wall_0 , wall_1
call wall_time ( wall_0 )
prin t * , 'providing the state average TWO-RDM ...'
call orb_range_two_rdm_state_av_openmp ( state_av_act_two_rdm_openmp_spin _trace_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_1 )
prin t * , 'Time to provide the state average TWO-RDM' , wall_1 - wall_0
END_ P ROVIDER