Working on truncate_wf

plugins/Full_CI_ZMQ/run_selection_slave.irp.f

@@ -57,7 +57,7 @@ subroutine run_selection_slave(thread,iproc,energy)
     endif
 
     if(done .or. ctask == size(task_id)) then
-      ASSERT (.not.(buf%N == 0 .and. ctask > 0))
+      ASSERT (buf%N /= 0)
       do i=1, ctask
          call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i))
       end do

plugins/QMC/truncate_wf_spin.irp.f

@@ -47,7 +47,7 @@ subroutine run
       !$OMP PARALLEL DO PRIVATE(k)
       do k=1,n_det
         if (psi_bilinear_matrix_columns(k) == -i) then
-          psi_bilinear_matrix_values(k,1) = 0.d0
+          psi_bilinear_matrix_values(k,1:N_states) = 0.d0
         endif
       enddo
       !$OMP END PARALLEL DO
@@ -55,7 +55,7 @@ subroutine run
       !$OMP PARALLEL DO PRIVATE(k)
       do k=1,n_det
         if (psi_bilinear_matrix_rows(k) ==  i) then
-          psi_bilinear_matrix_values(k,1) = 0.d0
+          psi_bilinear_matrix_values(k,1:N_states) = 0.d0
         endif
       enddo
       !$OMP END PARALLEL DO
@@ -85,20 +85,21 @@ subroutine run
     
     double precision, external :: u_dot_u, u_dot_v
     do i=1,N_states
-      e_0(i) = u_dot_v(v_t(1,i),u_0(1,i),N_det)/u_dot_u(u_0(1,i),N_det)
+      e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),N_det)/u_dot_u(u_0(1,i),N_det)
+      print *,  'E = ', e_0(i)
     enddo
 
     m = 0
     do k=1,n_det
-     if (psi_bilinear_matrix_values(k,1) /= 0.d0) then
+     if (sum(psi_bilinear_matrix_values(k,1:N_states)) /= 0.d0) then
       m = m+1
      endif
     enddo
 
-    E = E_0(1) + nuclear_repulsion
+    do k=1,N_states
-    norm = u_dot_u(u_0(1,1),N_det)
+      E = E_0(k) + nuclear_repulsion
+    enddo
     print *,  'Number of determinants:', m
-    print *,  'Energy', E
     exit
   enddo
   call wf_of_psi_bilinear_matrix(.True.)

src/Determinants/determinants.irp.f

@@ -447,28 +447,12 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
 
   integer :: i,k
 
-  PROVIDE progress_bar
-  call start_progress(7,'Saving wfunction',0.d0)
-
-  progress_bar(1) = 1
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_N_int(N_int)
-  progress_bar(1) = 2
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_bit_kind(bit_kind)
-  progress_bar(1) = 3
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_N_det(ndet)
-  progress_bar(1) = 4
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_n_states(nstates)
-  progress_bar(1) = 5
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_mo_label(mo_label)
 
-  progress_bar(1) = 6
-  progress_value = dble(progress_bar(1))
-
   N_int2 = (N_int*bit_kind)/8
   allocate (psi_det_save(N_int2,2,ndet))
   do i=1,ndet
@@ -484,13 +468,10 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
     do k=1,N_int2
       psi_det_save(k,2,i) = det_8(k)
     enddo
-!   print*,psi_det_save
   enddo
   call ezfio_set_determinants_psi_det(psi_det_save)
   deallocate (psi_det_save)
 
-  progress_bar(1) = 7
-  progress_value = dble(progress_bar(1))
   allocate (psi_coef_save(ndet,nstates))
   double precision :: accu_norm(nstates)
   accu_norm = 0.d0
@@ -537,28 +518,12 @@ subroutine save_wavefunction_specified(ndet,nstates,psidet,psicoef,ndetsave,inde
 
   integer :: i,k
 
-  PROVIDE progress_bar
-  call start_progress(7,'Saving wfunction',0.d0)
-
-  progress_bar(1) = 1
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_N_int(N_int)
-  progress_bar(1) = 2
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_bit_kind(bit_kind)
-  progress_bar(1) = 3
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_N_det(ndetsave)
-  progress_bar(1) = 4
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_n_states(nstates)
-  progress_bar(1) = 5
-  progress_value = dble(progress_bar(1))
   call ezfio_set_determinants_mo_label(mo_label)
 
-  progress_bar(1) = 6
-  progress_value = dble(progress_bar(1))
-
   N_int2 = (N_int*bit_kind)/8
   allocate (psi_det_save(N_int2,2,ndetsave))
   do i=1,ndetsave

src/Determinants/spindeterminants.irp.f

@@ -365,8 +365,9 @@ end
  do k=1,N_det
    i = psi_bilinear_matrix_rows(k)
    j = psi_bilinear_matrix_columns(k)
+   f = 0.d0
    do l=1,N_states
-    f = psi_bilinear_matrix_values(k,l)*psi_bilinear_matrix_values(k,l)
+    f += psi_bilinear_matrix_values(k,l)*psi_bilinear_matrix_values(k,l)
    enddo
    det_alpha_norm(i) += f
    det_beta_norm(j)  += f