From a6e844ad615579334567a28bd0e3ab02c0b81b15 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Fri, 16 Dec 2022 13:29:59 +0100 Subject: [PATCH] Looks like CIS is working. --- src/csf/configuration_CI_sigma_helpers.irp.f | 25 +-- src/csf/conversion.irp.f | 2 +- src/csf/obtain_I_foralpha.irp.f | 68 ++++---- src/csf/sigma_vector.irp.f | 167 +++++++++++++------ src/davidson/diagonalization_hcfg.irp.f | 30 ++-- 5 files changed, 182 insertions(+), 110 deletions(-) diff --git a/src/csf/configuration_CI_sigma_helpers.irp.f b/src/csf/configuration_CI_sigma_helpers.irp.f index 578a9153..4473b1fa 100644 --- a/src/csf/configuration_CI_sigma_helpers.irp.f +++ b/src/csf/configuration_CI_sigma_helpers.irp.f @@ -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))) diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f index 7c6c8363..92c8e669 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -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 diff --git a/src/csf/obtain_I_foralpha.irp.f b/src/csf/obtain_I_foralpha.irp.f index 1d4e81fc..8b588f4e 100644 --- a/src/csf/obtain_I_foralpha.irp.f +++ b/src/csf/obtain_I_foralpha.irp.f @@ -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 diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index 9fe81fe9..193fcf0e 100644 --- a/src/csf/sigma_vector.irp.f +++ b/src/csf/sigma_vector.irp.f @@ -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 diff --git a/src/davidson/diagonalization_hcfg.irp.f b/src/davidson/diagonalization_hcfg.irp.f index b88c188d..00bbf543 100644 --- a/src/davidson/diagonalization_hcfg.irp.f +++ b/src/davidson/diagonalization_hcfg.irp.f @@ -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