From 53f956e204d95f297c6119d7346950d0565a7c55 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 7 Jun 2021 15:15:01 +0200 Subject: [PATCH] Complete FCI --- devel/fci_complete/EZFIO.cfg | 6 ++ devel/fci_complete/NEED | 3 + devel/fci_complete/README.rst | 4 + devel/fci_complete/fci_complete.irp.f | 8 ++ devel/fci_complete/generate_fci.irp.f | 75 +++++++++++++++++++ devel/svdwf/buildpsi_diagSVDit_modif_v2.irp.f | 14 +--- 6 files changed, 98 insertions(+), 12 deletions(-) create mode 100644 devel/fci_complete/EZFIO.cfg create mode 100644 devel/fci_complete/NEED create mode 100644 devel/fci_complete/README.rst create mode 100644 devel/fci_complete/fci_complete.irp.f create mode 100644 devel/fci_complete/generate_fci.irp.f diff --git a/devel/fci_complete/EZFIO.cfg b/devel/fci_complete/EZFIO.cfg new file mode 100644 index 0000000..fd85bce --- /dev/null +++ b/devel/fci_complete/EZFIO.cfg @@ -0,0 +1,6 @@ +[energy] +type: double precision +doc: Calculated Selected |FCI| energy +interface: ezfio +size: (determinants.n_states) + diff --git a/devel/fci_complete/NEED b/devel/fci_complete/NEED new file mode 100644 index 0000000..b2918cc --- /dev/null +++ b/devel/fci_complete/NEED @@ -0,0 +1,3 @@ +davidson_undressed +hartree_fock +determinants diff --git a/devel/fci_complete/README.rst b/devel/fci_complete/README.rst new file mode 100644 index 0000000..4967020 --- /dev/null +++ b/devel/fci_complete/README.rst @@ -0,0 +1,4 @@ +=== +mpn +=== + diff --git a/devel/fci_complete/fci_complete.irp.f b/devel/fci_complete/fci_complete.irp.f new file mode 100644 index 0000000..5601583 --- /dev/null +++ b/devel/fci_complete/fci_complete.irp.f @@ -0,0 +1,8 @@ +program fci_complete + + call generate_fci_space + call diagonalize_ci + +end + + diff --git a/devel/fci_complete/generate_fci.irp.f b/devel/fci_complete/generate_fci.irp.f new file mode 100644 index 0000000..d66988b --- /dev/null +++ b/devel/fci_complete/generate_fci.irp.f @@ -0,0 +1,75 @@ +subroutine generate_fci_space + use bitmasks + implicit none + BEGIN_DOC +! Generates the complete FCI space + END_DOC + integer :: i, sze, ncore + integer(bit_kind) :: o(N_int,2) + integer(bit_kind) :: u, coremask + + if (mo_num > 64) then + stop 'No more than 64 MOs' + endif + + ncore = 0 + coremask = 0_bit_kind + do i=1,mo_num + if (trim(mo_class(i)) == 'Core') then + ncore += 1 + coremask = ibset(coremask,i-1) + endif + enddo + o(1,1) = iand(full_ijkl_bitmask(1),not(coremask)) + o(1,2) = 0_bit_kind + + call configuration_to_dets_size(o,n_det_alpha_unique,elec_alpha_num-ncore,N_int) + TOUCH n_det_alpha_unique + + integer :: k,n,m, t, t1, t2 + k=0 + n = elec_alpha_num + m = mo_num - n + n = n + + u = shiftl(1_bit_kind,n) -1 + do while (u < shiftl(1_bit_kind,n+m)) + if (iand(coremask, u) == coremask) then + k = k+1 + psi_det_alpha_unique(1,k) = u + endif + t = ior(u,u-1) + t1 = t+1 +IRP_IF WITHOUT_TRAILZ + t2 = shiftr((iand(not(t),t1)-1), popcnt(ieor(u,u-1))) +IRP_ELSE + t2 = shiftr((iand(not(t),t1)-1), trailz(u)+1) +IRP_ENDIF + u = ior(t1,t2) + enddo + + + call configuration_to_dets_size(o,n_det_beta_unique,elec_beta_num-ncore,N_int) + TOUCH n_det_beta_unique + + k=0 + n = elec_beta_num + m = mo_num - n + u = shiftl(1_bit_kind,n) -1 + do while (u < shiftl(1_bit_kind,n+m)) + if (iand(coremask, u) == coremask) then + k = k+1 + psi_det_beta_unique(1,k) = u + endif + t = ior(u,u-1) + t1 = t+1 + t2 = shiftr((iand(not(t),t1)-1), trailz(u)+1) + u = ior(t1,t2) + enddo + + call generate_all_alpha_beta_det_products + + print *, 'Ndet = ', N_det + +end + diff --git a/devel/svdwf/buildpsi_diagSVDit_modif_v2.irp.f b/devel/svdwf/buildpsi_diagSVDit_modif_v2.irp.f index 34411d3..0400909 100644 --- a/devel/svdwf/buildpsi_diagSVDit_modif_v2.irp.f +++ b/devel/svdwf/buildpsi_diagSVDit_modif_v2.irp.f @@ -227,18 +227,6 @@ subroutine run Ept2 += ctmp*ctmp / (E0 - (H_diag(i,j)+nuclear_repulsion) ) enddo enddo -! do j=n_selected+1,n_det_beta_unique -! do i=n_selected+1,n_det_alpha_unique -! ctmp = 0.d0 -! do l=1,n_selected -! do k=1,n_selected -! ctmp = ctmp + H(k,l,i,j) * psi_postsvd(k,l) -! enddo -! enddo -! psi_postsvd(i,j) = ctmp / (E0 - (H(i,j,i,j)+nuclear_repulsion) ) -! Ept2 += ctmp*ctmp / (E0 - (H(i,j,i,j)+nuclear_repulsion) ) -! enddo -! enddo tol_energy = dabs(E_prev - E0) print '(I5, 3(3X, F20.10))', it_svd, E0, E0 + Ept2, tol_energy @@ -403,6 +391,7 @@ subroutine const_H_uv(Uref, Vref, H, H_diag, n_selected) if ( degree > 2) cycle call i_H_j(det1, det2, N_int, h12) + if (h12 == 0.d0) cycle do m=1,nb tmp3(m,j,l) = tmp3(m,j,l) + h12 * tmp1(m,i) * tmp1(m,k) @@ -410,6 +399,7 @@ subroutine const_H_uv(Uref, Vref, H, H_diag, n_selected) do n=1,n_selected c_tmp = h12 * Vref(j,n) + if (c_tmp == 0.d0) cycle do m=1,n_selected H0(k,l,m,n) = H0(k,l,m,n) + c_tmp * tmp1(m,i) enddo