Merge pull request #269 from QuantumPackage/dev-stable

Dev stable

src/davidson/diagonalization_hs2_dressed.irp.f

@@ -465,7 +465,8 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
        integer :: lwork, info
        double precision, allocatable :: work(:)
 
-       y = h
+!       y = h
+       y = h_p
        lwork = -1
        allocate(work(1))
        call dsygv(1,'V','U',shift2,y,size(y,1), &

src/determinants/h_apply.irp.f

@@ -69,9 +69,15 @@ subroutine resize_H_apply_buffer(new_size,iproc)
   END_DOC
   PROVIDE H_apply_buffer_allocated
 
+
   ASSERT (new_size > 0)
   ASSERT (iproc >= 0)
   ASSERT (iproc < nproc)
+  if (N_det < 0) call abort() !irp_here//': N_det < 0')
+  if (N_int <= 0) call abort() !irp_here//': N_int <= 0')
+  if (new_size <= 0) call abort() !irp_here//': new_size <= 0')
+  if (iproc < 0) call abort() !irp_here//': iproc < 0')
+  if (iproc >= nproc) call abort() !irp_here//': iproc >= nproc')
 
   allocate ( buffer_det(N_int,2,new_size),                           &
       buffer_coef(new_size,N_states),                                &
@@ -126,8 +132,10 @@ subroutine copy_H_apply_buffer_to_wf
 
 
   ASSERT (N_int > 0)
-  ASSERT (N_det > 0)
+  ASSERT (N_det >= 0)
 
+  N_det_old = N_det
+  if (N_det > 0) then
      allocate ( buffer_det(N_int,2,N_det), buffer_coef(N_det,N_states) )
 
      ! Backup determinants
@@ -151,6 +159,7 @@ subroutine copy_H_apply_buffer_to_wf
        enddo
        ASSERT ( j == N_det_old )
      enddo
+  endif
 
   ! Update N_det
   N_det = N_det_old
@@ -164,6 +173,7 @@ subroutine copy_H_apply_buffer_to_wf
     TOUCH psi_det_size
   endif
 
+  if (N_det_old > 0) then
     ! Restore backup in resized array
     do i=1,N_det_old
       psi_det(:,:,i) = buffer_det(:,:,i)
@@ -175,6 +185,7 @@ subroutine copy_H_apply_buffer_to_wf
         psi_coef(i,k) = buffer_coef(i,k)
       enddo
     enddo
+  endif
 
   ! Copy new buffers
 
@@ -339,3 +350,33 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
   call omp_unset_lock(H_apply_buffer_lock(1,iproc))
 end
 
+
+subroutine replace_wf(N_det_new, LDA, psi_coef_new, psi_det_new)
+  use omp_lib
+  implicit none
+  BEGIN_DOC
+! Replaces the wave function.
+! After calling this subroutine, N_det, psi_det and psi_coef need to be touched
+  END_DOC
+  integer, intent(in)            :: N_det_new, LDA
+  double precision, intent(in)   :: psi_coef_new(LDA,N_states)
+  integer(bit_kind), intent(in)  :: psi_det_new(N_int,2,N_det_new)
+
+  integer                        :: i,j
+
+  PROVIDE H_apply_buffer_allocated
+
+  if (N_det_new <= 0) call abort() !irp_here//': N_det_new <= 0')
+  if (N_int <= 0) call abort() !irp_here//': N_int <= 0')
+  if (LDA < N_det_new) call abort() !irp_here//': LDA < N_det_new')
+
+  do j=0,nproc-1
+    H_apply_buffer(j)%N_det = 0
+  enddo
+  N_det = 0
+  SOFT_TOUCH N_det
+  call fill_H_apply_buffer_no_selection(N_det_new,psi_det_new,N_int,0)
+  call copy_h_apply_buffer_to_wf
+  psi_coef(1:N_det_new,1:N_states) = psi_coef_new(1:N_det_new,1:N_states)
+
+end