Add dmc_dress

devel/dmc_dress/EZFIO.cfg

@@ -0,0 +1,6 @@
+[dmc_delta_h]
+type: double precision
+doc: Dressing matrix obtained from DMC
+size: (determinants.n_det)
+interface: ezfio, provider
+

devel/dmc_dress/NEED

@@ -0,0 +1,3 @@
+selectors_full
+generators_full
+davidson_dressed

devel/dmc_dress/README.rst

@@ -0,0 +1,4 @@
+=========
+dmc_dress
+=========
+

devel/dmc_dress/dmc_dress.irp.f

@@ -0,0 +1,19 @@
+program diagonalize_h
+ implicit none
+ BEGIN_DOC
+! Program that extracts the lowest states of the Hamiltonian dressed by the QMC
+! dressing vector stored in :option:`dmc_dressing dmc_delta_h`
+!
+ END_DOC
+ read_wf = .True.
+ touch read_wf
+ call routine
+ call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted)
+end
+
+subroutine routine
+ implicit none
+ psi_coef(1:N_det,1) = ci_eigenvectors_dressed(1:N_det,1)
+ print*,'N_det = ',N_det
+ SOFT_TOUCH psi_coef
+end

devel/dmc_dress/dressing_vector.irp.f

@@ -0,0 +1,24 @@
+ BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ]
+&BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ]
+ implicit none
+ BEGIN_DOC
+ ! \Delta_{state-specific}. \Psi
+ END_DOC
+
+ integer :: i,ii,k,j, l
+ double precision :: f, tmp
+ double precision, external :: u_dot_v
+ logical, external :: detEq
+
+ dressing_column_h(:,:) = 0.d0
+ dressing_column_s(:,:) = 0.d0
+
+ l = dressed_column_idx(1)
+ do j = 1, n_det
+   dressing_column_h(j,1) = 0.5d0*dmc_delta_h(j)
+   dressing_column_h(l,1) -= 0.5d0 * psi_coef(j,1) * dmc_delta_h(j) /psi_coef(l,1)
+ enddo
+END_PROVIDER
+
+
+

devel/fci_complete/generate_fci.irp.f

@@ -8,9 +8,6 @@ subroutine generate_fci_space
   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
@@ -23,13 +20,26 @@ subroutine generate_fci_space
   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)
+  integer :: norb
+  norb = mo_num
+  do i=1,mo_num
+    if (trim(mo_class(i)) == 'Deleted') then
+      norb -= 1
+      o(1,1) = ibclr(o(1,1) ,i-1)
+    endif
+  enddo
+
+  if (norb > 64) then
+     stop 'No more than 64 MOs'
+  endif
+
+  call configuration_to_dets_size(act_bitmask,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
+  m = norb - n
   n = n
 
   u = shiftl(1_bit_kind,n) -1
@@ -49,12 +59,12 @@ IRP_ENDIF
   enddo
 
 
-  call configuration_to_dets_size(o,n_det_beta_unique,elec_beta_num-ncore,N_int)
+  call configuration_to_dets_size(act_bitmask,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
+  m = norb - n
   u = shiftl(1_bit_kind,n) -1
   do while (u < shiftl(1_bit_kind,n+m))
     if (iand(coremask, u) == coremask) then

devel/svdwf/svdwf.irp.f

@@ -42,6 +42,7 @@ subroutine run
   endif
 
   entropy = 0.d0
+  k=n_det_beta_unique
   do i=1,n_det_beta_unique
     print *, i, real(D(i)), real(D(i)**2), real(sum(D(1:i)**2))
     entropy -= D(i) * dlog(D(i))
@@ -53,6 +54,7 @@ subroutine run
   print *, 'threshold: ', 2.858 * D(k/2)
   print *, 'Entropy  : ', entropy
 
+  call ezfio_set_spindeterminants_n_svd_coefs(min(n_det_beta_unique,n_det_alpha_unique))
   call ezfio_set_spindeterminants_psi_svd_alpha(U)
   call ezfio_set_spindeterminants_psi_svd_beta (Vt)
   call ezfio_set_spindeterminants_psi_svd_coefs(D)