From 7ac793cc52b25aacad7694246286927ea7c4bcc5 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 6 Oct 2017 15:41:44 +0200 Subject: [PATCH] Working on truncate_wf --- plugins/Full_CI_ZMQ/run_selection_slave.irp.f | 2 +- plugins/QMC/truncate_wf_spin.irp.f | 15 ++++---- src/Davidson/diagonalization_hs2.irp.f | 2 +- src/Determinants/determinants.irp.f | 35 ------------------- src/Determinants/spindeterminants.irp.f | 3 +- 5 files changed, 12 insertions(+), 45 deletions(-) diff --git a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f index ceb7bd95..8684eb0f 100644 --- a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f +++ b/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 diff --git a/plugins/QMC/truncate_wf_spin.irp.f b/plugins/QMC/truncate_wf_spin.irp.f index 5a5fe125..b0769efd 100644 --- a/plugins/QMC/truncate_wf_spin.irp.f +++ b/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 - norm = u_dot_u(u_0(1,1),N_det) + do k=1,N_states + E = E_0(k) + nuclear_repulsion + enddo print *, 'Number of determinants:', m - print *, 'Energy', E exit enddo call wf_of_psi_bilinear_matrix(.True.) diff --git a/src/Davidson/diagonalization_hs2.irp.f b/src/Davidson/diagonalization_hs2.irp.f index 0a2d5389..dd330644 100644 --- a/src/Davidson/diagonalization_hs2.irp.f +++ b/src/Davidson/diagonalization_hs2.irp.f @@ -139,7 +139,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ write(iunit,'(A)') trim(write_buffer) write_buffer = ' Iter' do i=1,N_st - write_buffer = trim(write_buffer)//' Energy S^2 Residual ' + write_buffer = trim(write_buffer)//' Energy S^2 Residual ' enddo write(iunit,'(A)') trim(write_buffer) write_buffer = '===== ' diff --git a/src/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index 9a1d4ee1..dd272014 100644 --- a/src/Determinants/determinants.irp.f +++ b/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 diff --git a/src/Determinants/spindeterminants.irp.f b/src/Determinants/spindeterminants.irp.f index b6ca1cba..75c2ee31 100644 --- a/src/Determinants/spindeterminants.irp.f +++ b/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