PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-07-22 10:47:38 +02:00
Code Releases Activity

Working on frozen core for CFG-CI.

Browse Source
This commit is contained in:
v1j4y 2022-06-17 11:05:27 +02:00
parent 4064243da3
commit a6859c072b
5 changed files with 149 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
src/csf/configuration_CI_sigma_helpers.irp.f
View File

@ -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)

9
src/csf/create_excitations.irp.f
View File

@ -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)

20
src/csf/obtain_I_foralpha.irp.f
View File

@ -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

55
src/csf/sigma_vector.irp.f
View File

@ -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)

52
src/mo_two_e_ints/core_quantities.irp.f
View File

@ -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