From a56488e3a865dccc98d7984dd2cc4a7be1885539 Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 12 Mar 2024 18:23:09 +0100 Subject: [PATCH] fci_tc_bi_ortho works for multi state ninja --- .../cipsi_tc_bi_ortho/stochastic_cipsi.irp.f | 57 ++++--------------- plugins/local/fci_tc_bi/diagonalize_ci.irp.f | 42 +------------- .../local/tc_bi_ortho/psi_det_tc_sorted.irp.f | 8 ++- src/cipsi/pt2_stoch_routines.irp.f | 2 +- src/cipsi_utils/slave_cipsi.irp.f | 2 +- 5 files changed, 20 insertions(+), 91 deletions(-) diff --git a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f index 721564e6..99a8de7e 100644 --- a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f @@ -11,15 +11,13 @@ subroutine run_stochastic_cipsi implicit none integer :: i, j, k, ndet integer :: to_select - logical :: print_pt2 logical :: has type(pt2_type) :: pt2_data, pt2_data_err double precision :: rss - double precision :: correlation_energy_ratio, E_denom, E_tc, norm + double precision :: correlation_energy_ratio double precision :: hf_energy_ref double precision :: relative_error - double precision, allocatable :: ept2(:), pt1(:), extrap_energy(:) - double precision, allocatable :: zeros(:) + double precision, allocatable :: zeros(:),E_tc(:), norm(:) logical, external :: qp_stop double precision, external :: memory_of_double @@ -32,14 +30,13 @@ subroutine run_stochastic_cipsi write(*,*) i, Fock_matrix_tc_mo_tot(i,i) enddo - N_iter = 1 threshold_generators = 1.d0 SOFT_TOUCH threshold_generators rss = memory_of_double(N_states)*4.d0 call check_mem(rss, irp_here) - allocate(zeros(N_states)) + allocate(zeros(N_states),E_tc(N_states), norm(N_states)) call pt2_alloc(pt2_data, N_states) call pt2_alloc(pt2_data_err, N_states) @@ -55,8 +52,7 @@ subroutine run_stochastic_cipsi ! if (s2_eig) then ! call make_s2_eigenfunction ! endif - print_pt2 = .False. - call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) + call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm) ! if (N_det > N_det_max) then @@ -67,19 +63,16 @@ subroutine run_stochastic_cipsi ! if (s2_eig) then ! call make_s2_eigenfunction ! endif -! print_pt2 = .False. -! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2) +! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm) ! call routine_save_right ! endif - allocate(ept2(1000),pt1(1000),extrap_energy(100)) correlation_energy_ratio = 0.d0 ! thresh_it_dav = 5.d-5 ! soft_touch thresh_it_dav - print_pt2 = .True. do while( (N_det < N_det_max) .and. & (maxval(abs(pt2_data % pt2(1:N_states))) > pt2_max)) @@ -90,13 +83,12 @@ subroutine run_stochastic_cipsi to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor) to_select = max(N_states_diag, to_select) - E_denom = E_tc ! TC Energy of the current wave function print*,'E_tc = ',E_tc call pt2_dealloc(pt2_data) call pt2_dealloc(pt2_data_err) call pt2_alloc(pt2_data, N_states) call pt2_alloc(pt2_data_err, N_states) - call ZMQ_pt2(E_denom, pt2_data, pt2_data_err, relative_error,to_select) ! Stochastic PT2 and selection + call ZMQ_pt2(E_tc, pt2_data, pt2_data_err, relative_error,to_select) ! Stochastic PT2 and selection ! stop call print_summary_tc(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, N_det, N_configuration, N_states, psi_s2) @@ -117,48 +109,19 @@ subroutine run_stochastic_cipsi PROVIDE psi_det PROVIDE psi_det_sorted_tc - ept2(N_iter-1) = E_tc + nuclear_repulsion + (pt2_data % pt2(1))/norm - pt1(N_iter-1) = dsqrt(pt2_data % overlap(1,1)) - call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) + call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm) ! stop if (qp_stop()) exit enddo -! print*,'data to extrapolate ' -! do i = 2, N_iter -! print*,'iteration ',i -! print*,'pt1,Ept2',pt1(i),ept2(i) -! call get_extrapolated_energy(i-1,ept2(i),pt1(i),extrap_energy(i)) -! do j = 2, i -! print*,'j,e,energy',j,extrap_energy(j) -! enddo -! enddo - -! thresh_it_dav = 5.d-6 -! soft_touch thresh_it_dav call pt2_dealloc(pt2_data) call pt2_dealloc(pt2_data_err) call pt2_alloc(pt2_data, N_states) call pt2_alloc(pt2_data_err, N_states) call ZMQ_pt2(E_tc, pt2_data, pt2_data_err, relative_error,0) ! Stochastic PT2 and selection - call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2) -! if (.not.qp_stop()) then -! if (N_det < N_det_max) then -! thresh_it_dav = 5.d-7 -! soft_touch thresh_it_dav -! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2) -! endif -! -! call pt2_dealloc(pt2_data) -! call pt2_dealloc(pt2_data_err) -! call pt2_alloc(pt2_data, N_states) -! call pt2_alloc(pt2_data_err, N_states) -! call ZMQ_pt2(E_denom, pt2_data, pt2_data_err, relative_error, 0) ! Stochastic PT2 -! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2) -! endif -! call pt2_dealloc(pt2_data) -! call pt2_dealloc(pt2_data_err) -! call routine_save_right + call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm) + call pt2_dealloc(pt2_data) + call pt2_dealloc(pt2_data_err) end diff --git a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f index 5fcce5eb..85518116 100644 --- a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f +++ b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f @@ -1,7 +1,7 @@ ! --- -subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) +subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm ) BEGIN_DOC ! Replace the coefficients of the CI states by the coefficients of the @@ -12,50 +12,10 @@ subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) implicit none integer, intent(inout) :: ndet ! number of determinants from before double precision, intent(inout) :: E_tc(N_states), norm(N_states) ! E and norm from previous wave function - type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function - logical, intent(in) :: print_pt2 integer :: i, j,k - double precision:: pt2_minus,pt2_plus,pt2_tot, pt2_abs,pt1_norm,rpt2_tot - double precision :: error_pt2_minus, error_pt2_plus, error_pt2_tot, error_pt2_abs PROVIDE mo_l_coef mo_r_coef -! print*,'*****' -! print*,'New wave function information' -! print*,'N_det tc = ',N_det -! do k = 1, N_states -! print*,'************' -! print*,'State ',k -! pt2_plus = pt2_data % variance(k) -! pt2_minus = pt2_data % pt2(k) -! pt2_abs = pt2_plus - pt2_minus -! pt2_tot = pt2_plus + pt2_minus -! -! pt1_norm = pt2_data % overlap(k,k) -! rpt2_tot = pt2_tot / (1.d0 + pt1_norm) -! -! -! print*,'norm_ground_left_right_bi_orth = ',norm_ground_left_right_bi_orth(k) -! print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(k) -! print*,'*****' -! -! if(print_pt2) then -! print*,'*****' -! print*,'previous wave function info' -! print*,'norm(before) = ',norm -! print*,'E(before) = ',E_tc -! print*,'PT1 norm = ',dsqrt(pt1_norm) -! print*,'PT2 = ',pt2_tot -! print*,'rPT2 = ',rpt2_tot -! print*,'|PT2| = ',pt2_abs -! print*,'Positive PT2 = ',pt2_plus -! print*,'Negative PT2 = ',pt2_minus -! print*,'E(before) + PT2 = ',E_tc + pt2_tot/norm -! print*,'E(before) +rPT2 = ',E_tc + rpt2_tot/norm -! write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tot/norm,E_tc + rpt2_tot/norm,pt2_minus, pt2_plus -! print*,'*****' -! endif -! enddo do k = 1, N_states E_tc(k) = eigval_right_tc_bi_orth(k) norm(k) = norm_ground_left_right_bi_orth(k) diff --git a/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f b/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f index 5dad91ca..eef99de8 100644 --- a/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f +++ b/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f @@ -11,10 +11,16 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_tc, (psi_det_size) ] psi_average_norm_contrib_tc(:) = 0.d0 do k=1,N_states do i=1,N_det - psi_average_norm_contrib_tc(i) = & +! print*,dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k)),psi_l_coef_bi_ortho(i,k),psi_r_coef_bi_ortho(i,k) + psi_average_norm_contrib_tc(i) += & dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k))*state_average_weight(k) enddo enddo +! print*,'***' +! do i = 1, N_det +! print*,psi_average_norm_contrib_tc(i) +! enddo + print*,'sum(psi_average_norm_contrib_tc(1:N_det))',sum(psi_average_norm_contrib_tc(1:N_det)) f = 1.d0/sum(psi_average_norm_contrib_tc(1:N_det)) do i=1,N_det psi_average_norm_contrib_tc(i) = psi_average_norm_contrib_tc(i)*f diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 228e0ef1..bd5943da 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -1,3 +1,3 @@ subroutine provide_for_zmq_pt2 - PROVIDE psi_selectors_coef_transp psi_det_sorted psi_det_sorted_order + PROVIDE psi_selectors_coef_transp psi_det_sorted psi_det_sorted_order psi_det_hii end diff --git a/src/cipsi_utils/slave_cipsi.irp.f b/src/cipsi_utils/slave_cipsi.irp.f index 8be48f40..3e778270 100644 --- a/src/cipsi_utils/slave_cipsi.irp.f +++ b/src/cipsi_utils/slave_cipsi.irp.f @@ -306,7 +306,7 @@ subroutine run_slave_main PROVIDE psi_bilinear_matrix_rows psi_bilinear_matrix_order PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp - PROVIDE psi_det_hii selection_weight pseudo_sym pt2_min_parallel_tasks + PROVIDE selection_weight pseudo_sym pt2_min_parallel_tasks call provide_for_zmq_pt2 if (mpi_master) then