mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-21 11:03:29 +01:00
Working on frozen core for CFG-CI.
This commit is contained in:
v1j4y
parent
4064243da3
commit
a6859c072b
@ -31,9 +31,9 @@ use bitmasks
|
||||
integer :: ndiffDOMO
|
||||
integer :: nxordiffSOMODOMO
|
||||
integer :: ndiffAll
|
||||
integer :: i
|
||||
integer :: j
|
||||
integer :: k
|
||||
integer :: i,ii
|
||||
integer :: j,jj
|
||||
integer :: k,kk
|
||||
integer :: kstart
|
||||
integer :: kend
|
||||
integer :: Nsomo_I
|
||||
@ -55,13 +55,15 @@ use bitmasks
|
||||
|
||||
Icfg = psi_configuration(:,:,idxI)
|
||||
|
||||
Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2))
|
||||
Isomo = iand(act_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(act_bitmask(1,1),Icfg(1,2))
|
||||
|
||||
! find out all pq holes possible
|
||||
nholes = 0
|
||||
! holes in SOMO
|
||||
do i = 1,mo_num
|
||||
!do i = 1,mo_num
|
||||
do ii = 1,n_act_orb
|
||||
i = list_act(ii)
|
||||
if(POPCNT(IAND(Isomo,IBSET(0_8,i-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = i
|
||||
@ -69,7 +71,9 @@ use bitmasks
|
||||
endif
|
||||
end do
|
||||
! holes in DOMO
|
||||
do i = 1,mo_num
|
||||
!do i = 1,mo_num
|
||||
do ii = 1,n_act_orb
|
||||
i = list_act(ii)
|
||||
if(POPCNT(IAND(Idomo,IBSET(0_8,i-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = i
|
||||
@ -81,7 +85,9 @@ use bitmasks
|
||||
listvmos = -1
|
||||
vmotype = -1
|
||||
nvmos = 0
|
||||
do i = 1,mo_num
|
||||
!do i = 1,mo_num
|
||||
do ii = 1,n_act_orb
|
||||
i = list_act(ii)
|
||||
if(IAND(Idomo,(IBSET(0_8,i-1))) .EQ. 0) then
|
||||
if(IAND(Isomo,(IBSET(0_8,i-1))) .EQ. 0) then
|
||||
nvmos += 1
|
||||
@ -98,8 +104,8 @@ use bitmasks
|
||||
tableUniqueAlphas = .FALSE.
|
||||
|
||||
! Now find the allowed (p,q) excitations
|
||||
Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2))
|
||||
Isomo = iand(act_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(act_bitmask(1,1),Icfg(1,2))
|
||||
Nsomo_I = POPCNT(Isomo)
|
||||
if(Nsomo_I .EQ. 0) then
|
||||
kstart = 1
|
||||
@ -239,10 +245,10 @@ use bitmasks
|
||||
Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2))
|
||||
kstart = max(1,cfg_seniority_index(max(0,Nsomo_I-2)))
|
||||
do k = kstart, idxI-1
|
||||
diffSOMO = IEOR(Isomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,1,k)))
|
||||
diffSOMO = IEOR(Isomo,iand(act_bitmask(1,1),psi_configuration(1,1,k)))
|
||||
ndiffSOMO = POPCNT(diffSOMO)
|
||||
if (ndiffSOMO /= 2) cycle
|
||||
diffDOMO = IEOR(Idomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,2,k)))
|
||||
diffDOMO = IEOR(Idomo,iand(act_bitmask(1,1),psi_configuration(1,2,k)))
|
||||
xordiffSOMODOMO = IEOR(diffSOMO,diffDOMO)
|
||||
ndiffDOMO = POPCNT(diffDOMO)
|
||||
nxordiffSOMODOMO = POPCNT(xordiffSOMODOMO)
|
||||
@ -298,9 +304,9 @@ END_PROVIDER
|
||||
integer :: ndiffDOMO
|
||||
integer :: nxordiffSOMODOMO
|
||||
integer :: ndiffAll
|
||||
integer :: i
|
||||
integer :: j
|
||||
integer :: k
|
||||
integer :: i, ii
|
||||
integer :: j, jj
|
||||
integer :: k, kk
|
||||
integer :: kstart
|
||||
integer :: kend
|
||||
integer :: Nsomo_I
|
||||
@ -311,8 +317,8 @@ END_PROVIDER
|
||||
logical :: pqAlreadyGenQ
|
||||
logical :: pqExistsQ
|
||||
logical :: ppExistsQ
|
||||
Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2))
|
||||
Isomo = iand(act_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(act_bitmask(1,1),Icfg(1,2))
|
||||
!print*,"Input cfg"
|
||||
!call debug_spindet(Isomo,1)
|
||||
!call debug_spindet(Idomo,1)
|
||||
@ -322,7 +328,9 @@ END_PROVIDER
|
||||
! find out all pq holes possible
|
||||
nholes = 0
|
||||
! holes in SOMO
|
||||
do i = 1,mo_num
|
||||
!do i = 1,mo_num
|
||||
do ii = 1,n_act_orb
|
||||
i = list_act(ii)
|
||||
if(POPCNT(IAND(Isomo,IBSET(0_8,i-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = i
|
||||
@ -330,7 +338,9 @@ END_PROVIDER
|
||||
endif
|
||||
end do
|
||||
! holes in DOMO
|
||||
do i = 1,mo_num
|
||||
!do i = 1,mo_num
|
||||
do ii = 1,n_act_orb
|
||||
i = list_act(ii)
|
||||
if(POPCNT(IAND(Idomo,IBSET(0_8,i-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = i
|
||||
@ -342,7 +352,9 @@ END_PROVIDER
|
||||
listvmos = -1
|
||||
vmotype = -1
|
||||
nvmos = 0
|
||||
do i = 1,mo_num
|
||||
!do i = 1,mo_num
|
||||
do ii = 1,n_act_orb
|
||||
i = list_act(ii)
|
||||
!print *,i,IBSET(0,i-1),POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))), POPCNT(IAND(Idomo,(IBSET(0_8,i-1))))
|
||||
if(POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))) .EQ. 0 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,i-1)))) .EQ. 0) then
|
||||
nvmos += 1
|
||||
@ -363,8 +375,8 @@ END_PROVIDER
|
||||
tableUniqueAlphas = .FALSE.
|
||||
|
||||
! Now find the allowed (p,q) excitations
|
||||
Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2))
|
||||
Isomo = iand(act_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(act_bitmask(1,1),Icfg(1,2))
|
||||
Nsomo_I = POPCNT(Isomo)
|
||||
if(Nsomo_I .EQ. 0) then
|
||||
kstart = 1
|
||||
@ -430,10 +442,10 @@ END_PROVIDER
|
||||
pqAlreadyGenQ = .FALSE.
|
||||
! First check if it can be generated before
|
||||
do k = kstart, kend
|
||||
diffSOMO = IEOR(Jsomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,1,k)))
|
||||
diffSOMO = IEOR(Jsomo,iand(act_bitmask(1,1),psi_configuration(1,1,k)))
|
||||
ndiffSOMO = POPCNT(diffSOMO)
|
||||
if((ndiffSOMO .NE. 0) .AND. (ndiffSOMO .NE. 2)) cycle
|
||||
diffDOMO = IEOR(Jdomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,2,k)))
|
||||
diffDOMO = IEOR(Jdomo,iand(act_bitmask(1,1),psi_configuration(1,2,k)))
|
||||
xordiffSOMODOMO = IEOR(diffSOMO,diffDOMO)
|
||||
ndiffDOMO = POPCNT(diffDOMO)
|
||||
nxordiffSOMODOMO = POPCNT(xordiffSOMODOMO)
|
||||
@ -534,11 +546,11 @@ END_PROVIDER
|
||||
|
||||
! Check if this Icfg has been previously generated as a mono
|
||||
ppExistsQ = .False.
|
||||
Isomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(reunion_of_act_virt_bitmask(1,1),Icfg(1,2))
|
||||
Isomo = iand(act_bitmask(1,1),Icfg(1,1))
|
||||
Idomo = iand(act_bitmask(1,1),Icfg(1,2))
|
||||
do k = 1, idxI-1
|
||||
diffSOMO = IEOR(Isomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,1,k)))
|
||||
diffDOMO = IEOR(Idomo,iand(reunion_of_act_virt_bitmask(1,1),psi_configuration(1,2,k)))
|
||||
diffSOMO = IEOR(Isomo,iand(act_bitmask(1,1),psi_configuration(1,1,k)))
|
||||
diffDOMO = IEOR(Idomo,iand(act_bitmask(1,1),psi_configuration(1,2,k)))
|
||||
xordiffSOMODOMO = IEOR(diffSOMO,diffDOMO)
|
||||
ndiffSOMO = POPCNT(diffSOMO)
|
||||
ndiffDOMO = POPCNT(diffDOMO)
|
||||
|
||||
@ -249,6 +249,7 @@ subroutine generate_all_singles_cfg_with_type(bit_tmp,cfgInp,singles,idxs_single
|
||||
integer(bit_kind) :: Jdet(Nint,2)
|
||||
|
||||
integer :: i,k, n_singles_ma, i_hole, i_particle, ex_type, addcfg
|
||||
integer :: ii,kk
|
||||
integer(bit_kind) :: single(Nint,2)
|
||||
logical :: i_ok
|
||||
|
||||
@ -257,8 +258,12 @@ subroutine generate_all_singles_cfg_with_type(bit_tmp,cfgInp,singles,idxs_single
|
||||
!TODO
|
||||
!Make list of Somo and Domo for holes
|
||||
!Make list of Unocc and Somo for particles
|
||||
do i_hole = 1+n_core_orb, n_core_orb + n_act_orb
|
||||
do i_particle = 1+n_core_orb, n_core_orb + n_act_orb
|
||||
!do i_hole = 1+n_core_orb, n_core_orb + n_act_orb
|
||||
do ii = 1, n_act_orb
|
||||
i_hole = list_act(ii)
|
||||
!do i_particle = 1+n_core_orb, n_core_orb + n_act_orb
|
||||
do kk = 1, n_act_orb
|
||||
i_particle = list_act(kk)
|
||||
if(i_hole .EQ. i_particle) cycle
|
||||
addcfg = -1
|
||||
call do_single_excitation_cfg_with_type(cfgInp,single,i_hole,i_particle,ex_type,i_ok)
|
||||
|
||||
@ -33,7 +33,7 @@ subroutine obtain_connected_J_givenI(idxI, givenI, connectedI, idxs_connectedI,
|
||||
integer :: ndiffSOMO
|
||||
integer :: ndiffDOMO
|
||||
integer :: nxordiffSOMODOMO
|
||||
integer :: ii,i,j,k,l,p,q,nsomoJ,nsomoalpha,starti,endi,extyp,nholes
|
||||
integer :: iii,ii,i,j,k,l,p,q,nsomoJ,nsomoalpha,starti,endi,extyp,nholes
|
||||
integer :: listholes(mo_num)
|
||||
integer :: holetype(mo_num)
|
||||
integer :: end_index
|
||||
@ -146,7 +146,9 @@ subroutine obtain_connected_J_givenI(idxI, givenI, connectedI, idxs_connectedI,
|
||||
! holes in SOMO
|
||||
Isomo = psi_configuration(1,1,i)
|
||||
Idomo = psi_configuration(1,2,i)
|
||||
do ii = 1,mo_num
|
||||
!do ii = 1,mo_num
|
||||
do iii = 1,n_act_orb
|
||||
ii = list_act(iii)
|
||||
if(POPCNT(IAND(Isomo,IBSET(0_8,ii-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = ii
|
||||
@ -154,7 +156,9 @@ subroutine obtain_connected_J_givenI(idxI, givenI, connectedI, idxs_connectedI,
|
||||
endif
|
||||
end do
|
||||
! holes in DOMO
|
||||
do ii = 1,mo_num
|
||||
!do ii = 1,mo_num
|
||||
do iii = 1,n_act_orb
|
||||
ii = list_act(iii)
|
||||
if(POPCNT(IAND(Idomo,IBSET(0_8,ii-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = ii
|
||||
@ -204,7 +208,7 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
|
||||
integer :: ndiffSOMO
|
||||
integer :: ndiffDOMO
|
||||
integer :: nxordiffSOMODOMO
|
||||
integer :: ii,i,j,k,l,p,q,nsomoJ,nsomoalpha,starti,endi,extyp,nholes
|
||||
integer :: iii,ii,i,j,k,l,p,q,nsomoJ,nsomoalpha,starti,endi,extyp,nholes
|
||||
integer :: listholes(mo_num)
|
||||
integer :: holetype(mo_num)
|
||||
integer :: end_index
|
||||
@ -335,7 +339,9 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
|
||||
! holes in SOMO
|
||||
Isomo = psi_configuration(1,1,i)
|
||||
Idomo = psi_configuration(1,2,i)
|
||||
do ii = 1,mo_num
|
||||
!do ii = 1,mo_num
|
||||
do iii = 1,n_act_orb
|
||||
ii = list_act(iii)
|
||||
if(POPCNT(IAND(Isomo,IBSET(0_8,ii-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = ii
|
||||
@ -343,7 +349,9 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
|
||||
endif
|
||||
end do
|
||||
! holes in DOMO
|
||||
do ii = 1,mo_num
|
||||
!do ii = 1,mo_num
|
||||
do iii = 1,n_act_orb
|
||||
ii = list_act(iii)
|
||||
if(POPCNT(IAND(Idomo,IBSET(0_8,ii-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = ii
|
||||
|
||||
@ -810,7 +810,7 @@ subroutine calculate_preconditioner_cfg(diag_energies)
|
||||
! the configurations in psi_configuration
|
||||
! returns : diag_energies :
|
||||
END_DOC
|
||||
integer :: i,j,k,l,p,q,noccp,noccq, ii, jj
|
||||
integer :: i,j,k,kk,l,p,q,noccp,noccq, ii, jj
|
||||
real*8,intent(out) :: diag_energies(n_CSF)
|
||||
integer :: nholes
|
||||
integer :: nvmos
|
||||
@ -838,16 +838,19 @@ subroutine calculate_preconditioner_cfg(diag_energies)
|
||||
real*8 :: meCC
|
||||
real*8 :: ecore
|
||||
|
||||
PROVIDE h_core_ri
|
||||
!PROVIDE h_core_ri
|
||||
PROVIDE core_fock_operator
|
||||
PROVIDE h_act_ri
|
||||
! initialize energies
|
||||
diag_energies = 0.d0
|
||||
!print *,"Core energy=",core_energy," nucler rep=",nuclear_repulsion, " n_core_orb=",n_core_orb," n_act_orb=",n_act_orb," mo_num=",mo_num
|
||||
|
||||
! calculate core energy
|
||||
!call get_core_energy(ecore)
|
||||
!diag_energies = ecore
|
||||
diag_energies = core_energy - nuclear_repulsion
|
||||
|
||||
! calculate the core energy
|
||||
!print *,"Core energy=",ref_bitmask_energy
|
||||
!print *,"Core 2energy=",ref_bitmask_energy
|
||||
|
||||
do i=1,N_configuration
|
||||
|
||||
@ -863,8 +866,9 @@ subroutine calculate_preconditioner_cfg(diag_energies)
|
||||
! find out all pq holes possible
|
||||
nholes = 0
|
||||
! holes in SOMO
|
||||
!do k = n_core_orb+1,n_core_orb + n_act_orb
|
||||
do k = 1,mo_num
|
||||
!do k = 1,mo_num
|
||||
do kk = 1,n_act_orb
|
||||
k = list_act(kk)
|
||||
if(POPCNT(IAND(Isomo,IBSET(0_8,k-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = k
|
||||
@ -874,7 +878,9 @@ subroutine calculate_preconditioner_cfg(diag_energies)
|
||||
! holes in DOMO
|
||||
!do k = n_core_orb+1,n_core_orb + n_act_orb
|
||||
!do k = 1+n_core_inact_orb,n_core_orb+n_core_inact_act_orb
|
||||
do k = 1,mo_num
|
||||
!do k = 1,mo_num
|
||||
do kk = 1,n_act_orb
|
||||
k = list_act(kk)
|
||||
if(POPCNT(IAND(Idomo,IBSET(0_8,k-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = k
|
||||
@ -887,7 +893,9 @@ subroutine calculate_preconditioner_cfg(diag_energies)
|
||||
vmotype = -1
|
||||
nvmos = 0
|
||||
!do k = n_core_orb+1,n_core_orb + n_act_orb
|
||||
do k = 1,mo_num
|
||||
!do k = 1,mo_num
|
||||
do kk = 1,n_act_orb
|
||||
k = list_act(kk)
|
||||
!print *,i,IBSET(0,i-1),POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))), POPCNT(IAND(Idomo,(IBSET(0_8,i-1))))
|
||||
if(POPCNT(IAND(Isomo,(IBSET(0_8,k-1)))) .EQ. 0 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,k-1)))) .EQ. 0) then
|
||||
nvmos += 1
|
||||
@ -916,7 +924,7 @@ subroutine calculate_preconditioner_cfg(diag_energies)
|
||||
|
||||
! one-electron term
|
||||
if(p.EQ.q) then
|
||||
hpp = noccq * h_core_ri(p,q)!mo_one_e_integrals(q,q)
|
||||
hpp = noccq * h_act_ri(p,q)!mo_one_e_integrals(q,q)
|
||||
else
|
||||
hpp = 0.d0
|
||||
endif
|
||||
@ -1295,7 +1303,8 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
|
||||
real*8,intent(in) :: psi_in(n_st,sze)
|
||||
real*8,intent(out) :: psi_out(n_st,sze)
|
||||
integer(bit_kind) :: Icfg(N_INT,2)
|
||||
integer :: i,j,k,l,p,q,noccp,noccq, ii, jj, m, n, idxI, kk, nocck,orbk
|
||||
integer :: i,j,k,l,p,q,noccp,noccq, m, n, idxI, nocck,orbk
|
||||
integer :: ii,jj,kk,ll,pp,qq
|
||||
integer(bit_kind),dimension(:,:,:),allocatable :: listconnectedJ
|
||||
integer(bit_kind),dimension(:,:,:),allocatable :: alphas_Icfg
|
||||
integer(bit_kind),dimension(:,:,:),allocatable :: singlesI
|
||||
@ -1394,10 +1403,10 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
|
||||
!$OMP colsikpq, GIJpqrs,TKIGIJ,j,l,m,TKI,CCmattmp, moi, moj, mok, mol,&
|
||||
!$OMP diagfac, tmpvar, diagfactors_0) &
|
||||
!$OMP shared(istart_cfg, iend_cfg, psi_configuration, mo_num, psi_config_data,&
|
||||
!$OMP N_int, N_st, psi_out, psi_in, h_core_ri, AIJpqContainer,&
|
||||
!$OMP N_int, N_st, psi_out, psi_in, h_core_ri, core_energy, h_act_ri, AIJpqContainer,&
|
||||
!$OMP sze, NalphaIcfg_list,alphasIcfg_list, bit_tmp, &
|
||||
!$OMP AIJpqMatrixDimsList, diag_energies, n_CSF, lock, NBFmax,nconnectedtotalmax, nconnectedmaxJ,maxnalphas,&
|
||||
!$OMP num_threads_max)
|
||||
!$OMP n_core_orb, n_act_orb, list_act, num_threads_max)
|
||||
|
||||
allocate(singlesI(N_INT,2,max(sze,10000)))
|
||||
allocate(idxs_singlesI(max(sze,10000)))
|
||||
@ -1430,8 +1439,9 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
|
||||
! list_core
|
||||
! list_core_inact
|
||||
! bitmasks
|
||||
!do k = n_core_orb+1,n_core_orb + n_act_orb
|
||||
do k = 1,mo_num
|
||||
!do k = 1,mo_num
|
||||
do kk = 1,n_act_orb
|
||||
k = list_act(kk)
|
||||
if(POPCNT(IAND(Isomo,IBSET(0_8,k-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = k
|
||||
@ -1439,8 +1449,9 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
|
||||
endif
|
||||
enddo
|
||||
! holes in DOMO
|
||||
!do k = n_core_orb+1,n_core_orb + n_act_orb
|
||||
do k = 1,mo_num
|
||||
!do k = 1,mo_num
|
||||
do kk = 1,n_act_orb
|
||||
k = list_act(kk)
|
||||
if(POPCNT(IAND(Idomo,IBSET(0_8,k-1))) .EQ. 1) then
|
||||
nholes += 1
|
||||
listholes(nholes) = k
|
||||
@ -1452,8 +1463,9 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
|
||||
listvmos = -1
|
||||
vmotype = -1
|
||||
nvmos = 0
|
||||
!do k = n_core_orb+1,n_core_orb + n_act_orb
|
||||
do k = 1,mo_num
|
||||
do kk = 1,n_act_orb
|
||||
!do k = 1,mo_num
|
||||
k = list_act(kk)
|
||||
!print *,i,IBSET(0,i-1),POPCNT(IAND(Isomo,(IBSET(0_8,i-1)))), POPCNT(IAND(Idomo,(IBSET(0_8,i-1))))
|
||||
if(POPCNT(IAND(Isomo,(IBSET(0_8,k-1)))) .EQ. 0 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,k-1)))) .EQ. 0) then
|
||||
nvmos += 1
|
||||
@ -1507,7 +1519,8 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
|
||||
cnti = ii-starti+1
|
||||
do jj = startj, endj
|
||||
cntj = jj-startj+1
|
||||
meCC1 = AIJpqContainer(cnti,cntj,pmodel,qmodel,extype,NSOMOI)* h_core_ri(p,q)
|
||||
!meCC1 = AIJpqContainer(cnti,cntj,pmodel,qmodel,extype,NSOMOI)* h_core_ri(p,q)
|
||||
meCC1 = AIJpqContainer(cnti,cntj,pmodel,qmodel,extype,NSOMOI)* h_act_ri(p,q)
|
||||
!print *,"jj = ",jj
|
||||
call omp_set_lock(lock(jj))
|
||||
do kk = 1,n_st
|
||||
@ -1532,6 +1545,8 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
|
||||
deallocate(excitationIds_single)
|
||||
deallocate(excitationTypes_single)
|
||||
|
||||
!print *," psi(60,1)=",psi_out(1,60)
|
||||
|
||||
allocate(listconnectedJ(N_INT,2,max(sze,10000)))
|
||||
allocate(alphas_Icfg(N_INT,2,max(sze,10000)))
|
||||
allocate(connectedI_alpha(N_INT,2,max(sze,10000)))
|
||||
@ -1711,6 +1726,8 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
|
||||
|
||||
!$OMP END PARALLEL
|
||||
call omp_set_max_active_levels(4)
|
||||
!print *," psi(60,1)=",psi_out(1,60)
|
||||
!print *," diag_enregy=",diag_energies(1), " psi_out(1,1)=",psi_out(1,1)
|
||||
|
||||
deallocate(diag_energies)
|
||||
deallocate(bit_tmp)
|
||||
|
||||
@ -13,7 +13,19 @@ BEGIN_PROVIDER [double precision, core_energy]
|
||||
core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l))
|
||||
enddo
|
||||
enddo
|
||||
!print *," core no nucl=",core_energy
|
||||
! core-active
|
||||
do i = 1, n_core_orb
|
||||
j = list_core(i)
|
||||
!!! VJ
|
||||
!!! TODO: Correct the loop over active electrons
|
||||
do k = 1, (elec_num - 2*n_core_orb)/2
|
||||
l = k + n_core_orb
|
||||
core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l))
|
||||
enddo
|
||||
enddo
|
||||
core_energy += nuclear_repulsion
|
||||
!print *," core no nucl=",core_energy
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -59,3 +71,43 @@ BEGIN_PROVIDER [ double precision, h_core_ri, (mo_num, mo_num) ]
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, h_act_ri, (mo_num, mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Active Hamiltonian with 3-index exchange integrals:
|
||||
!
|
||||
! $\tilde{h}{pq} = h_{pq} - \frac{1}{2}\sum_{k} g(pk,kq)$
|
||||
END_DOC
|
||||
|
||||
integer :: i,j, k
|
||||
integer :: p,q, r
|
||||
! core-core contribution
|
||||
h_act_ri = core_fock_operator
|
||||
! act-act contribution
|
||||
do p=1,n_act_orb
|
||||
j=list_act(p)
|
||||
do q=1,n_act_orb
|
||||
i=list_act(q)
|
||||
h_act_ri(i,j) = mo_one_e_integrals(i,j)
|
||||
enddo
|
||||
do r=1,n_act_orb
|
||||
k=list_act(r)
|
||||
do q=1,n_act_orb
|
||||
i=list_act(q)
|
||||
h_act_ri(i,j) = h_act_ri(i,j) - 0.5 * big_array_exchange_integrals(k,i,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
! core-act contribution
|
||||
do p=1,n_core_orb
|
||||
j=list_core(p)
|
||||
do k=1,mo_num
|
||||
do q=1,n_act_orb
|
||||
i=list_act(q)
|
||||
h_act_ri(i,j) = h_act_ri(i,j) - 0.5 * big_array_exchange_integrals(k,i,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user