Working on truncate_wf

plugins/Full_CI_ZMQ/run_selection_slave.irp.f

@@ -57,7 +57,6 @@ subroutine run_selection_slave(thread,iproc,energy)
     endif
 
     if(done .or. ctask == size(task_id)) then
-      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

@@ -39,7 +39,8 @@ subroutine run
   call dsort(norm_sort(1),iorder(1),nab)
 
 
-  PROVIDE psi_bilinear_matrix_values nuclear_repulsion 
+  PROVIDE psi_bilinear_matrix_values psi_bilinear_matrix_rows psi_bilinear_matrix_columns
+  PROVIDE nuclear_repulsion 
   print *,  ''
   do j=0,nab
     i = iorder(j)
@@ -47,7 +48,9 @@ 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:N_states) = 0.d0
+          do l=1,N_states
+            psi_bilinear_matrix_values(k,l) = 0.d0
+          enddo
         endif
       enddo
       !$OMP END PARALLEL DO
@@ -55,7 +58,9 @@ 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:N_states) = 0.d0
+          do l=1,N_states
+            psi_bilinear_matrix_values(k,l) = 0.d0
+          enddo
         endif
       enddo
       !$OMP END PARALLEL DO
@@ -64,9 +69,11 @@ subroutine run
       cycle
     endif
 
-    u_0 = psi_bilinear_matrix_values(1:N_det,1:N_states)
+    u_0(1:N_det,1:N_states) = psi_bilinear_matrix_values(1:N_det,1:N_states)
-    v_t = 0.d0
+    v_0(1:N_det,1:N_states) = 0.d0
-    s_t = 0.d0
+    u_t(1:N_states,1:N_det) = 0.d0
+    v_t(1:N_states,1:N_det) = 0.d0
+    s_t(1:N_states,1:N_det) = 0.d0
     call dtranspose(                                                   &
         u_0,                                                           &
         size(u_0, 1),                                                  &
@@ -85,8 +92,8 @@ subroutine run
     
     double precision, external :: u_dot_u, u_dot_v
     do i=1,N_states
-      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)
+      e_0(i) = u_dot_v(u_0(1,i),v_0(1,i),N_det)/u_dot_u(u_0(1,i),N_det)
-      print *,  'E = ', e_0(i)
+      print *,  'E = ', e_0(i) + nuclear_repulsion
     enddo
 
     m = 0

src/Determinants/determinants.irp.f

@@ -435,17 +435,14 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
 !  Save the wave function into the EZFIO file
   END_DOC
   use bitmasks
+  include 'constants.include.F'
   integer, intent(in) :: ndet,nstates,dim_psicoef
   integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
   double precision, intent(in)  :: psicoef(dim_psicoef,nstates)
   integer*8, allocatable         :: psi_det_save(:,:,:)
   double precision, allocatable  :: psi_coef_save(:,:)
-  integer*8                      :: det_8(100)
-  integer(bit_kind)              :: det_bk((100*8)/bit_kind)
-  integer                        :: N_int2
-  equivalence (det_8, det_bk)
 
-  integer :: i,k
+  integer :: i,j,k
 
   call ezfio_set_determinants_N_int(N_int)
   call ezfio_set_determinants_bit_kind(bit_kind)
@@ -453,21 +450,13 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
   call ezfio_set_determinants_n_states(nstates)
   call ezfio_set_determinants_mo_label(mo_label)
 
-  N_int2 = (N_int*bit_kind)/8
+  allocate (psi_det_save(N_int,2,ndet))
-  allocate (psi_det_save(N_int2,2,ndet))
   do i=1,ndet
+   do j=1,2
     do k=1,N_int
-      det_bk(k) = psidet(k,1,i)
+      psi_det_save(k,j,i) = transfer(psidet(k,j,i),1_8)
-    enddo
-    do k=1,N_int2
-      psi_det_save(k,1,i) = det_8(k)
-    enddo
-    do k=1,N_int
-      det_bk(k) = psidet(k,2,i)
-    enddo
-    do k=1,N_int2
-      psi_det_save(k,2,i) = det_8(k)
     enddo
+   enddo
   enddo
   call ezfio_set_determinants_psi_det(psi_det_save)
   deallocate (psi_det_save)
@@ -492,7 +481,6 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
 
   call ezfio_set_determinants_psi_coef(psi_coef_save)
   call write_int(output_determinants,ndet,'Saved determinants')
-  call stop_progress
   deallocate (psi_coef_save)
 end
 
@@ -565,7 +553,6 @@ subroutine save_wavefunction_specified(ndet,nstates,psidet,psicoef,ndetsave,inde
 
   call ezfio_set_determinants_psi_coef(psi_coef_save)
   call write_int(output_determinants,ndet,'Saved determinants')
-  call stop_progress
   deallocate (psi_coef_save)
 end
 

src/Utils/transpose.irp.f

@@ -47,6 +47,14 @@ recursive subroutine dtranspose(A,LDA,B,LDB,d1,d2)
  double precision, intent(in) :: A(LDA,d2)
  double precision, intent(out) :: B(LDB,d1)
 
+
+! do j=1,d1
+!   do i=1,d2
+!    B(i,j  ) = A(j  ,i)
+!   enddo
+! enddo
+! return
+
  integer :: i,j,k, mod_align
  if ( d2 < 32 ) then
    do j=1,d1