LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-09 06:53:38 +01:00
Code Releases Activity

Looks like CIS is working.

Browse Source
This commit is contained in:
v1j4y 2022-12-16 13:29:59 +01:00
parent bb0c3e391c
commit a6e844ad61
5 changed files with 182 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -586,7 +586,7 @@ use bitmasks
do i=1, N_int
Isomo(i) = iand(act_bitmask(i,1),psi_configuration(i,1,idxI))
Idomo(i) = iand(act_bitmask(i,1),psi_configuration(i,2,idxI))
Idomo(i) = iand(act_bitmask(i,2),psi_configuration(i,2,idxI))
enddo
! find out all pq holes possible
@ -667,7 +667,7 @@ use bitmasks
qq = listvmos(j)
if(pp.eq.qq) cycle
jint = shiftr(qq-1,bit_kind_shift) + 1
jpos = qq-shiftl((iint-1),bit_kind_shift)-1
jpos = qq-shiftl((jint-1),bit_kind_shift)-1
if(vmotype(j) == 1)then
Jsomo(jint) = IBSET(Jsomo(jint),jpos)
else if(vmotype(j) == 2)then
@ -769,7 +769,7 @@ use bitmasks
! prune list of alphas
do i=1, N_int
Isomo(i) = iand(act_bitmask(i,1),psi_configuration(i,1,idxI))
Idomo(i) = iand(act_bitmask(i,1),psi_configuration(i,2,idxI))
Idomo(i) = iand(act_bitmask(i,2),psi_configuration(i,2,idxI))
Jsomo(i) = Isomo(i)
Jdomo(i) = Idomo(i)
enddo
@ -790,7 +790,7 @@ use bitmasks
do j = 1, nvmos
qq = listvmos(j)
jint = shiftr(qq-1,bit_kind_shift) + 1
jpos = qq-shiftl((iint-1),bit_kind_shift)-1
jpos = qq-shiftl((jint-1),bit_kind_shift)-1
if(vmotype(j) == 1)then
Jsomo(jint) = IBSET(Jsomo(jint),jpos)
else if(vmotype(j) == 2)then
@ -857,7 +857,7 @@ use bitmasks
ppExistsQ = .False.
do i=1, N_int
Isomo(i) = iand(act_bitmask(i,1),psi_configuration(i,1,idxI))
Idomo(i) = iand(act_bitmask(i,1),psi_configuration(i,2,idxI))
Idomo(i) = iand(act_bitmask(i,2),psi_configuration(i,2,idxI))
enddo
kstart = max(1,cfg_seniority_index(max(NSOMOMin,Nsomo_I-2)))
@ -953,7 +953,7 @@ END_PROVIDER
do i=1, N_int
Isomo(i) = iand(act_bitmask(i,1),Icfg(i,1))
Idomo(i) = iand(act_bitmask(i,1),Icfg(i,2))
Idomo(i) = iand(act_bitmask(i,2),Icfg(i,2))
enddo
!print*,"Input cfg"
@ -985,6 +985,7 @@ END_PROVIDER
! find vmos
! Take into account N_int
nvmos=0
do ii = 1, n_act_orb
iii = list_act(ii)
iint = shiftr(iii-1,bit_kind_shift) + 1
@ -1014,7 +1015,7 @@ END_PROVIDER
! Now find the allowed (p,q) excitations
do i=1, N_int
Isomo(i) = iand(act_bitmask(i,1),Icfg(i,1))
Idomo(i) = iand(act_bitmask(i,1),Icfg(i,2))
Idomo(i) = iand(act_bitmask(i,2),Icfg(i,2))
Jsomo(i) = Isomo(i)
Jdomo(i) = Idomo(i)
enddo
@ -1051,7 +1052,7 @@ END_PROVIDER
do j = 1,nvmos
qq = listvmos(j)
jint = shiftr(qq-1,bit_kind_shift) + 1
jpos = qq-shiftl((iint-1),bit_kind_shift)-1
jpos = qq-shiftl((jint-1),bit_kind_shift)-1
if(vmotype(j) == 1)then
Jsomo(jint) = IBSET(Jsomo(jint),jpos)
else if(vmotype(j) == 2)then
@ -1157,7 +1158,7 @@ END_PROVIDER
! prune list of alphas
do i=1, N_int
Isomo(i) = iand(act_bitmask(i,1),Icfg(i,1))
Idomo(i) = iand(act_bitmask(i,1),Icfg(i,2))
Idomo(i) = iand(act_bitmask(i,2),Icfg(i,2))
Jsomo(i) = Isomo(i)
Jdomo(i) = Idomo(i)
enddo
@ -1176,7 +1177,7 @@ END_PROVIDER
do j = 1, nvmos
qq = listvmos(j)
jint = shiftr(qq-1,bit_kind_shift) + 1
jpos = qq-shiftl((iint-1),bit_kind_shift)-1
jpos = qq-shiftl((jint-1),bit_kind_shift)-1
if(vmotype(j) == 1)then
Jsomo(jint) = IBSET(Jsomo(jint),jpos)
else if(vmotype(j) == 2)then
@ -1207,8 +1208,8 @@ END_PROVIDER
! Check if this Icfg has been previously generated as a mono
ppExistsQ = .False.
Isomo = iand(act_bitmask(1,1),Icfg(1,1))
Idomo = iand(act_bitmask(1,1),Icfg(1,2))
!Isomo = iand(act_bitmask(1,1),Icfg(1,1))
!Idomo = iand(act_bitmask(1,2),Icfg(1,2))
do k = 1, idxI-1
do ii=1,N_int
diffSOMO = IEOR(Icfg(ii,1),iand(act_bitmask(ii,1),psi_configuration(ii,1,k)))

2
src/csf/conversion.irp.f
View File

@ -114,7 +114,7 @@ subroutine convertWFfromCSFtoDET(N_st,psi_coef_cfg_in, psi_coef_det)
integer :: idx
integer MS
MS = elec_alpha_num-elec_beta_num
print *,"size=",size(tmp_psi_coef_det,1)," ",size(tmp_psi_coef_det,2)
!print *,"size=",size(tmp_psi_coef_det,1)," ",size(tmp_psi_coef_det,2)
countcsf = 0

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

@ -324,14 +324,14 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
! SOMO -> VMO
!print *,"obt SOMO -> VMO"
extyp = 3
if(N_int .eq. 1) then
IJsomo = IEOR(Isomo, Jsomo)
p = TRAILZ(IAND(Isomo,IJsomo)) + 1
IJsomo = IBCLR(IJsomo,p-1)
q = TRAILZ(IJsomo) + 1
!print *," p=",p," q=",q
!call get_single_excitation_cfg(Jcfg, Icfg, p, q, N_int)
else
!if(N_int .eq. 1) then
! IJsomo = IEOR(Isomo, Jsomo)
! p = TRAILZ(IAND(Isomo,IJsomo)) + 1
! IJsomo = IBCLR(IJsomo,p-1)
! q = TRAILZ(IJsomo) + 1
! !print *," p=",p," q=",q
! !call get_single_excitation_cfg(Jcfg, Icfg, p, q, N_int)
!else
! Find p
do ii=1,N_int
Isomo = Ialpha(ii,1)
@ -357,7 +357,7 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
EXIT
endif
enddo
endif
!endif
!assert ( p == pp)
!assert ( q == qq)
!print *," 1--- p=",p," q=",q
@ -369,12 +369,12 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
! DOMO -> VMO
!print *,"obt DOMO -> VMO"
extyp = 2
if(N_int.eq.1)then
p = TRAILZ(IEOR(Idomo,Jdomo)) + 1
Isomo = IEOR(Isomo, Jsomo)
Isomo = IBCLR(Isomo,p-1)
q = TRAILZ(Isomo) + 1
else
!if(N_int.eq.1)then
! p = TRAILZ(IEOR(Idomo,Jdomo)) + 1
! Isomo = IEOR(Isomo, Jsomo)
! Isomo = IBCLR(Isomo,p-1)
! q = TRAILZ(Isomo) + 1
!else
! Find p
do ii=1,N_int
@ -402,23 +402,23 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
EXIT
endif
end do
endif
!endif
!assert ( p == pp)
!assert ( q == qq)
else
! SOMO -> SOMO
!print *,"obt SOMO -> SOMO"
extyp = 1
if(N_int.eq.1)then
q = TRAILZ(IEOR(Idomo,Jdomo)) + 1
Isomo = IEOR(Isomo, Jsomo)
Isomo = IBCLR(Isomo,q-1)
p = TRAILZ(Isomo) + 1
! Check for Minimal alpha electrons (MS)
!if(POPCNT(Isomo).lt.MS)then
! cycle
!endif
else
!if(N_int.eq.1)then
! q = TRAILZ(IEOR(Idomo,Jdomo)) + 1
! Isomo = IEOR(Isomo, Jsomo)
! Isomo = IBCLR(Isomo,q-1)
! p = TRAILZ(Isomo) + 1
! ! Check for Minimal alpha electrons (MS)
! !if(POPCNT(Isomo).lt.MS)then
! ! cycle
! !endif
!else
! Find p
!print *,"Ialpha somo=",Ialpha(1,1), Ialpha(2,1)," Ialpha domo=",Ialpha(1,2), Ialpha(2,2)
!print *,"J somo=",psi_configuration(1,1,i), psi_configuration(2,1,i)," J domo=",psi_configuration(1,2,i),&
@ -449,7 +449,7 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
EXIT
endif
enddo
endif
!endif
!assert ( p == pp)
!assert ( q == qq)
endif
@ -458,12 +458,12 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
! DOMO -> SOMO
!print *,"obt DOMO -> SOMO"
extyp = 4
if(N_int.eq.1)then
IJsomo = IEOR(Isomo, Jsomo)
p = TRAILZ(IAND(Jsomo,IJsomo)) + 1
IJsomo = IBCLR(IJsomo,p-1)
q = TRAILZ(IJsomo) + 1
else
!if(N_int.eq.1)then
! IJsomo = IEOR(Isomo, Jsomo)
! p = TRAILZ(IAND(Jsomo,IJsomo)) + 1
! IJsomo = IBCLR(IJsomo,p-1)
! q = TRAILZ(IJsomo) + 1
!else
! Find p
do ii=1,N_int
Isomo = Ialpha(ii,1)
@ -491,7 +491,7 @@ subroutine obtain_connected_I_foralpha(idxI, Ialpha, connectedI, idxs_connectedI
EXIT
endif
enddo
endif
!endif
!assert ( p == pp)
!assert ( q == qq)
!print *," 3--- p=",p," q=",q

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

@ -1538,8 +1538,13 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
integer :: rowsTKI
integer :: noccpp
integer :: istart_cfg, iend_cfg, num_threads_max
integer :: iint, jint, ipos, jpos, Nsomo_I, iii
integer :: nconnectedJ,nconnectedtotalmax,nconnectedmaxJ,maxnalphas,ntotJ
integer*8 :: MS, Isomo, Idomo, Jsomo, Jdomo, Ialpha, Ibeta
integer*8 :: MS,Ialpha, Ibeta
integer(bit_kind) :: Isomo(N_INT)
integer(bit_kind) :: Idomo(N_INT)
integer(bit_kind) :: Jsomo(N_INT)
integer(bit_kind) :: Jdomo(N_INT)
integer :: moi, moj, mok, mol, starti, endi, startj, endj, cnti, cntj, cntk
real*8 :: norm_coef_cfg, fac2eints
real*8 :: norm_coef_det
@ -1554,6 +1559,7 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
real*8,dimension(:),allocatable:: diag_energies
real*8 :: tmpvar, tmptot
real*8 :: core_act_contrib
integer :: listall(N_int*bit_kind_size), nelall
integer(omp_lock_kind), allocatable :: lock(:)
call omp_set_max_active_levels(1)
@ -1569,7 +1575,7 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
allocate(diag_energies(n_CSF))
call calculate_preconditioner_cfg(diag_energies)
print *," diag energy =",diag_energies(1)
!print *," diag energy =",diag_energies(1)
MS = 0
norm_coef_cfg=0.d0
@ -1615,6 +1621,7 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
!$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, core_energy, h_act_ri, AIJpqContainer,&
!$OMP pp, sze, NalphaIcfg_list,alphasIcfg_list, bit_tmp, &
!$OMP qq, iint, jint, ipos, jpos, nelall, listall, Nsomo_I, &
!$OMP AIJpqMatrixDimsList, diag_energies, n_CSF, lock, NBFmax,nconnectedtotalmax, nconnectedmaxJ,maxnalphas,&
!$OMP n_core_orb, n_act_orb, list_act, n, list_core, list_core_is_built,core_act_contrib, num_threads_max,&
!$OMP n_core_orb_is_built, mo_integrals_map, mo_integrals_map_is_built)
@ -1637,10 +1644,12 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
! else
! cycle
Icfg(1,1) = psi_configuration(1,1,i)
Icfg(1,2) = psi_configuration(1,2,i)
Isomo = Icfg(1,1)
Idomo = Icfg(1,2)
do ii=1,N_INT
Icfg(ii,1) = psi_configuration(ii,1,i)
Icfg(ii,2) = psi_configuration(ii,2,i)
Isomo(ii) = Icfg(ii,1)
Idomo(ii) = Icfg(ii,2)
enddo
NSOMOI = getNSOMO(Icfg)
! find out all pq holes possible
@ -1651,42 +1660,86 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
! list_core_inact
! bitmasks
!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
holetype(nholes) = 1
endif
enddo
! holes in DOMO
!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
holetype(nholes) = 2
endif
enddo
! 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
! holetype(nholes) = 1
! endif
! enddo
! ! holes in DOMO
! !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
! holetype(nholes) = 2
! endif
! enddo
! find vmos
! ! find vmos
listvmos = -1
vmotype = -1
nvmos = 0
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
listvmos(nvmos) = k
vmotype(nvmos) = 0
else if(POPCNT(IAND(Isomo,(IBSET(0_8,k-1)))) .EQ. 1 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,k-1)))) .EQ. 0 ) then
nvmos += 1
listvmos(nvmos) = k
vmotype(nvmos) = 1
end if
enddo
! 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
! listvmos(nvmos) = k
! vmotype(nvmos) = 0
! else if(POPCNT(IAND(Isomo,(IBSET(0_8,k-1)))) .EQ. 1 .AND. POPCNT(IAND(Idomo,(IBSET(0_8,k-1)))) .EQ. 0 ) then
! nvmos += 1
! listvmos(nvmos) = k
! vmotype(nvmos) = 1
! end if
! enddo
! find out all pq holes possible
nholes = 0
call bitstring_to_list(Isomo,listall,nelall,N_int)
do iii=1,nelall
nholes += 1
listholes(nholes) = listall(iii)
holetype(nholes) = 1
end do
Nsomo_I = nelall
call bitstring_to_list(Idomo,listall,nelall,N_int)
do iii=1,nelall
if(listall(iii) .gt. n_core_orb)then
nholes += 1
listholes(nholes) = listall(iii)
holetype(nholes) = 2
endif
end do
! find vmos
! Take into account N_int
do ii = 1, n_act_orb
iii = list_act(ii)
iint = shiftr(iii-1,bit_kind_shift) + 1
ipos = iii-shiftl((iint-1),bit_kind_shift)-1
if(IAND(Idomo(iint),(IBSET(0_8,ipos))) .EQ. 0) then
if(IAND(Isomo(iint),(IBSET(0_8,ipos))) .EQ. 0) then
nvmos += 1
listvmos(nvmos) = iii
vmotype(nvmos) = 1
else if(POPCNT(IAND(Isomo(iint),(IBSET(0_8,ipos)))) .EQ. 1) then
nvmos += 1
listvmos(nvmos) = iii
vmotype(nvmos) = 2
end if
end if
end do
! Icsf ids
@ -1705,16 +1758,31 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
extype = excitationTypes_single(j)
! Off diagonal terms
call convertOrbIdsToModelSpaceIds(Icfg, singlesI(1,1,j), p, q, extype, pmodel, qmodel)
Jsomo = singlesI(1,1,j)
Jdomo = singlesI(1,2,j)
do ii=1,N_INT
Jsomo(ii) = singlesI(1,1,j)
Jdomo(ii) = singlesI(1,2,j)
enddo
! Get actual p pos
pp = p
iint = shiftr(pp-1,bit_kind_shift) + 1
ipos = pp-shiftl((iint-1),bit_kind_shift)-1
! Get actual q pos
qq = q
jint = shiftr(qq-1,bit_kind_shift) + 1
jpos = qq-shiftl((jint-1),bit_kind_shift)-1
! Add the hole on J
if(POPCNT(IAND(Jsomo,IBSET(0_8,q-1))) .EQ. 1 .AND. POPCNT(IAND(Isomo,IBSET(0_8,q-1))) .EQ. 0) then
!if(POPCNT(IAND(Jsomo,IBSET(0_8,q-1))) .EQ. 1 .AND. POPCNT(IAND(Isomo,IBSET(0_8,q-1))) .EQ. 0) then
if(POPCNT(IAND(Jsomo(jint),IBSET(0_8,jpos))) .EQ. 1 .AND. POPCNT(IAND(Isomo(jint),IBSET(0_8,jpos))) .EQ. 0) then
nholes += 1
listholes(nholes) = q
holetype(nholes) = 1
endif
if((POPCNT(IAND(Jdomo,IBSET(0_8,q-1))) .EQ. 1 .AND. POPCNT(IAND(Idomo,IBSET(0_8,q-1))) .EQ. 0) .AND. POPCNT(IAND(Isomo,IBSET(0_8,q-1))) .EQ. 0) then
!if((POPCNT(IAND(Jdomo,IBSET(0_8,q-1))) .EQ. 1 .AND. POPCNT(IAND(Idomo,IBSET(0_8,q-1))) .EQ. 0) .AND. POPCNT(IAND(Isomo,IBSET(0_8,q-1))) .EQ. 0) then
if((POPCNT(IAND(Jdomo(jint),IBSET(0_8,jpos))) .EQ. 1 .AND. POPCNT(IAND(Idomo(jint),IBSET(0_8,jpos))) .EQ. 0) .AND.&
POPCNT(IAND(Isomo(jint),IBSET(0_8,jpos))) .EQ. 0) then
nholes += 1
listholes(nholes) = q
holetype(nholes) = 2
@ -1744,17 +1812,18 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
call omp_set_lock(lock(jj))
do kk = 1,n_st
psi_out(kk,jj) = psi_out(kk,jj) + meCC1 * psi_in(kk,ii)
print *,"jj=",jj,'psi_out(kk)=',psi_out(kk,jj)
enddo
call omp_unset_lock(lock(jj))
enddo
enddo
! Undo setting in listholes
if(POPCNT(IAND(Jsomo,IBSET(0_8,q-1))) .EQ. 1 .AND. POPCNT(IAND(Isomo,IBSET(0_8,q-1))) .EQ. 0) then
!if(POPCNT(IAND(Jsomo,IBSET(0_8,q-1))) .EQ. 1 .AND. POPCNT(IAND(Isomo,IBSET(0_8,q-1))) .EQ. 0) then
if(POPCNT(IAND(Jsomo(jint),IBSET(0_8,jpos))) .EQ. 1 .AND. POPCNT(IAND(Isomo(jint),IBSET(0_8,jpos))) .EQ. 0) then
nholes -= 1
endif
if((POPCNT(IAND(Jdomo,IBSET(0_8,q-1))) .EQ. 1 .AND. POPCNT(IAND(Idomo,IBSET(0_8,q-1))) .EQ. 0) .AND. POPCNT(IAND(Isomo,IBSET(0_8,q-1))) .EQ. 0) then
if((POPCNT(IAND(Jdomo(jint),IBSET(0_8,jpos))) .EQ. 1 .AND. POPCNT(IAND(Idomo(jint),IBSET(0_8,jpos))) .EQ. 0) .AND.&
POPCNT(IAND(Isomo(jint),IBSET(0_8,jpos))) .EQ. 0) then
nholes -= 1
endif
enddo
@ -1790,8 +1859,10 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
! else
! cycle
Icfg(1,1) = psi_configuration(1,1,i)
Icfg(1,2) = psi_configuration(1,2,i)
do ii=1,N_INT
Icfg(ii,1) = psi_configuration(ii,1,i)
Icfg(ii,2) = psi_configuration(ii,2,i)
enddo
starti = psi_config_data(i,1)
endi = psi_config_data(i,2)
@ -1806,7 +1877,7 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
! print *,"Nalpha > maxnalpha"
!endif
call obtain_connected_J_givenI(i, Icfg, listconnectedJ, idslistconnectedJ, nconnectedJ, ntotJ)
!call obtain_connected_J_givenI(i, Icfg, listconnectedJ, idslistconnectedJ, nconnectedJ, ntotJ)
! TODO : remove doubly excited for return
!print *,"I=",i," isomo=",psi_configuration(1,1,i)," idomo=",psi_configuration(1,2,i), " psiout=",psi_out(1,5), "Nalphas_Icfg=",Nalphas_Icfg

30
src/davidson/diagonalization_hcfg.irp.f
View File

@ -329,8 +329,8 @@ subroutine davidson_diag_cfg_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
tmpU(kk,ii) = U_csf(ii,shift+kk)
enddo
enddo
tmpU =0.0d0
tmpU(1,1)=1.0d0
!tmpU =0.0d0
!tmpU(1,1)=1.0d0
double precision :: irp_rdtsc
double precision :: ticks_0, ticks_1
integer*8 :: irp_imax
@ -345,19 +345,19 @@ subroutine davidson_diag_cfg_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
enddo
enddo
U_csf = 0.0d0
U_csf(1,1) = 1.0d0
u_in = 0.0d0
call convertWFfromCSFtoDET(N_st_diag,tmpU,U2)
call H_u_0_nstates_openmp(u_in,U2,N_st_diag,sze)
call convertWFfromDETtoCSF(N_st_diag,u_in(1,1),W_csf2(1,1))
do i=1,sze_csf
print *,"I=",i," qp=",W_csf2(i,1)," my=",W_csf(i,1)," diff=",dabs(W_csf2(i,1))-dabs(W_csf(i,1))
!if(dabs(dabs(W_csf2(i,1))-dabs(W_csf(i,1))) .gt. 1.0e-10)then
! print *,"somo=",psi_configuration(1,1,i)," domo=",psi_configuration(1,2,i)," diff=",dabs(W_csf2(i,1))-dabs(W_csf(i,1))
!endif
end do
stop
!U_csf = 0.0d0
!U_csf(1,1) = 1.0d0
!u_in = 0.0d0
!call convertWFfromCSFtoDET(N_st_diag,tmpU,U2)
!call H_u_0_nstates_openmp(u_in,U2,N_st_diag,sze)
!call convertWFfromDETtoCSF(N_st_diag,u_in(1,1),W_csf2(1,1))
!do i=1,sze_csf
! print *,"I=",i," qp=",W_csf2(i,1)," my=",W_csf(i,1)," diff=",dabs(W_csf2(i,1))-dabs(W_csf(i,1))
! !if(dabs(dabs(W_csf2(i,1))-dabs(W_csf(i,1))) .gt. 1.0e-10)then
! ! print *,"somo=",psi_configuration(1,1,i)," domo=",psi_configuration(1,2,i)," diff=",dabs(W_csf2(i,1))-dabs(W_csf(i,1))
! !endif
!end do
!stop
deallocate(tmpW)
deallocate(tmpU)
endif