From 7d0af986255cd2d4f054e2d59ad9d8f58b8f699a Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 11 Dec 2017 15:28:24 +0100 Subject: [PATCH 01/65] mrcc_zmq updated for recent changes --- plugins/mrcepa0/dressing.irp.f | 4 +- plugins/mrcepa0/dressing_slave.irp.f | 2 +- plugins/mrcepa0/ezfio_interface.irp.f | 80 ----------------------- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 33 ++++------ 4 files changed, 15 insertions(+), 104 deletions(-) delete mode 100644 plugins/mrcepa0/ezfio_interface.irp.f diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 620605ff..5dfa8556 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -925,7 +925,6 @@ end E_CI_before = mrcc_E0_denominator(1) + nuclear_repulsion threshold_selectors = 1.d0 threshold_generators = 1d0 - !errr = errr / 2d0 if(errr /= 0d0) then errr = errr / 2d0 ! (-mrcc_E0_denominator(1) + mrcc_previous_E(1)) / 1d1 else @@ -934,7 +933,7 @@ end relative_error = errr print *, "RELATIVE ERROR", relative_error call ZMQ_mrcc(E_CI_before, mrcc, delta_ij_mrcc_zmq, delta_ij_s2_mrcc_zmq, abs(relative_error)) - !errr = + mrcc_previous_E(:) = mrcc_E0_denominator(:) do i=N_det_non_ref,1,-1 delta_ii_mrcc_zmq(:,1) -= delta_ij_mrcc_zmq(:, i, 1) / psi_ref_coef(1,1) * psi_non_ref_coef(i, 1) @@ -950,7 +949,6 @@ END_PROVIDER use bitmasks implicit none integer :: i, j, i_state - !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc if(mrmode == 4) then do i = 1, N_det_ref diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index b897ff0f..46a24a57 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -516,7 +516,7 @@ end integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull integer :: KKsize = 1000000 - + integer, external :: add_task_to_taskserver call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'mrsc2') diff --git a/plugins/mrcepa0/ezfio_interface.irp.f b/plugins/mrcepa0/ezfio_interface.irp.f deleted file mode 100644 index 3627abe6..00000000 --- a/plugins/mrcepa0/ezfio_interface.irp.f +++ /dev/null @@ -1,80 +0,0 @@ -! DO NOT MODIFY BY HAND -! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py -! from file /home/garniron/quantum_package/src/mrcepa0/EZFIO.cfg - - -BEGIN_PROVIDER [ logical, perturbative_triples ] - implicit none - BEGIN_DOC -! Compute perturbative contribution of the Triples - END_DOC - - logical :: has - PROVIDE ezfio_filename - - call ezfio_has_mrcepa0_perturbative_triples(has) - if (has) then - call ezfio_get_mrcepa0_perturbative_triples(perturbative_triples) - else - print *, 'mrcepa0/perturbative_triples not found in EZFIO file' - stop 1 - endif - -END_PROVIDER - -BEGIN_PROVIDER [ double precision, thresh_dressed_ci ] - implicit none - BEGIN_DOC -! Threshold on the convergence of the dressed CI energy - END_DOC - - logical :: has - PROVIDE ezfio_filename - - call ezfio_has_mrcepa0_thresh_dressed_ci(has) - if (has) then - call ezfio_get_mrcepa0_thresh_dressed_ci(thresh_dressed_ci) - else - print *, 'mrcepa0/thresh_dressed_ci not found in EZFIO file' - stop 1 - endif - -END_PROVIDER - -BEGIN_PROVIDER [ integer, n_it_max_dressed_ci ] - implicit none - BEGIN_DOC -! Maximum number of dressed CI iterations - END_DOC - - logical :: has - PROVIDE ezfio_filename - - call ezfio_has_mrcepa0_n_it_max_dressed_ci(has) - if (has) then - call ezfio_get_mrcepa0_n_it_max_dressed_ci(n_it_max_dressed_ci) - else - print *, 'mrcepa0/n_it_max_dressed_ci not found in EZFIO file' - stop 1 - endif - -END_PROVIDER - -BEGIN_PROVIDER [ integer, lambda_type ] - implicit none - BEGIN_DOC -! lambda type - END_DOC - - logical :: has - PROVIDE ezfio_filename - - call ezfio_has_mrcepa0_lambda_type(has) - if (has) then - call ezfio_get_mrcepa0_lambda_type(lambda_type) - else - print *, 'mrcepa0/lambda_type not found in EZFIO file' - stop 1 - endif - -END_PROVIDER diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index 1ad9b8da..a6c893b4 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -5,7 +5,7 @@ END_PROVIDER subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) - use dress_types + !use dress_types use f77_zmq implicit none @@ -24,14 +24,14 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) double precision, external :: omp_get_wtime double precision :: time - double precision :: w(N_states) - + double precision :: w!(N_states) + integer, external :: add_task_to_taskserver provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral mrcc_weight psi_selectors - w(:) = 0.d0 - w(mrcc_stoch_istate) = 1.d0 + w = 0.d0 + w = 1.d0 call update_psi_average_norm_contrib(w) @@ -48,7 +48,7 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) integer, external :: zmq_put_N_det_generators integer, external :: zmq_put_N_det_selectors integer, external :: zmq_put_dvector - + integer, external :: zmq_set_running if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then stop 'Unable to put psi on ZMQ server' endif @@ -98,7 +98,6 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) stop 'Unable to add task to task server' endif endif - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then print *, irp_here, ': Failed in zmq_set_running' endif @@ -107,7 +106,7 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) !$OMP PRIVATE(i) i = omp_get_thread_num() if (i==0) then - call mrcc_collector(zmq_socket_pull,E(mrcc_stoch_istate), relative_error, delta, delta_s2, mrcc) + call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc) else call mrcc_slave_inproc(i) @@ -152,7 +151,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer(ZMQ_PTR), external :: new_zmq_pull_socket - integer(ZMQ_PTR) :: zmq_socket_pull + !integer(ZMQ_PTR) :: zmq_socket_pull integer :: more integer :: i, j, k, i_state, N, ntask @@ -167,6 +166,8 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m logical, allocatable :: actually_computed(:) integer :: total_computed + delta = 0d0 + delta_s2 = 0d0 allocate(delta_det(N_states, N_det_non_ref, 0:comb_teeth+1, 2)) allocate(cp(N_states, N_det_non_ref, N_cp, 2), mrcc_detail(N_states, N_det_generators)) allocate(delta_loc(N_states, N_det_non_ref, 2)) @@ -191,7 +192,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m actually_computed = .false. zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - zmq_socket_pull = new_zmq_pull_socket() + !zmq_socket_pull = new_zmq_pull_socket() allocate(task_id(N_det_generators), ind(1)) more = 1 if (time0 < 0.d0) then @@ -225,7 +226,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m toothMwen = tooth_of_det(ind(i)) fracted = (toothMwen /= 0) if(fracted) fracted = (ind(i) == first_det_of_teeth(toothMwen)) - + if(fracted) then delta_det(:,:,toothMwen-1, 1) += delta_loc(:,:,1) * (1d0-fractage(toothMwen)) delta_det(:,:,toothMwen-1, 2) += delta_loc(:,:,2) * (1d0-fractage(toothMwen)) @@ -262,7 +263,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m do i=2,N_det_generators if(.not. actually_computed(mrcc_jobs(i))) then - print *, "first not comp", i cur_cp = done_cp_at(i-1) exit end if @@ -303,7 +303,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m print *, irp_here, ': Error in sending abort signal (2)' endif endif - else if (cur_cp > old_cur_cp) then old_cur_cp = cur_cp @@ -316,7 +315,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m end do pullLoop if(total_computed == N_det_generators) then - print *, "TOTALLY COMPUTED" delta = 0d0 delta_s2 = 0d0 do i=comb_teeth+1,0,-1 @@ -325,22 +323,17 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m end do else - delta = cp(:,:,cur_cp,1) delta_s2 = cp(:,:,cur_cp,2) - do i=cp_first_tooth(cur_cp)-1,0,-1 delta += delta_det(:,:,i,1) delta_s2 += delta_det(:,:,i,2) end do end if - mrcc(1) = E - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - - call end_zmq_pull_socket(zmq_socket_pull) + !call end_zmq_pull_socket(zmq_socket_pull) end subroutine From ff8bc16a9c07ccb185c99225968d1210ecd86dbd Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 15 Dec 2017 16:21:04 +0100 Subject: [PATCH 02/65] dress_zmq with null dressing --- plugins/dress_zmq/dress_general.irp.f | 134 ++++ plugins/dress_zmq/dress_slave.irp.f | 75 +++ plugins/dress_zmq/dress_stoch_routines.irp.f | 617 +++++++++++++++++++ plugins/dress_zmq/dress_zmq.irp.f | 24 + plugins/dress_zmq/dressing.irp.f | 109 ++++ plugins/dress_zmq/energy.irp.f | 23 + plugins/dress_zmq/run_dress_slave.irp.f | 174 ++++++ 7 files changed, 1156 insertions(+) create mode 100644 plugins/dress_zmq/dress_general.irp.f create mode 100644 plugins/dress_zmq/dress_slave.irp.f create mode 100644 plugins/dress_zmq/dress_stoch_routines.irp.f create mode 100644 plugins/dress_zmq/dress_zmq.irp.f create mode 100644 plugins/dress_zmq/dressing.irp.f create mode 100644 plugins/dress_zmq/energy.irp.f create mode 100644 plugins/dress_zmq/run_dress_slave.irp.f diff --git a/plugins/dress_zmq/dress_general.irp.f b/plugins/dress_zmq/dress_general.irp.f new file mode 100644 index 00000000..1f33e2d6 --- /dev/null +++ b/plugins/dress_zmq/dress_general.irp.f @@ -0,0 +1,134 @@ + + +subroutine run(N_st,energy) + implicit none + + integer, intent(in) :: N_st + double precision, intent(out) :: energy(N_st) + + integer :: i,j + + double precision :: E_new, E_old, delta_e + integer :: iteration + + integer :: n_it_dress_max + double precision :: thresh_dress + double precision, allocatable :: lambda(:) + allocate (lambda(N_states)) + + thresh_dress = thresh_dressed_ci + n_it_dress_max = n_it_max_dressed_ci + + if(n_it_dress_max == 1) then + do j=1,N_states + do i=1,N_det + psi_coef(i,j) = CI_eigenvectors_dressed(i,j) + enddo + enddo + SOFT_TOUCH psi_coef ci_energy_dressed + call write_double(6,ci_energy_dressed(1),"Final dress energy") + call ezfio_set_mrcepa0_energy(ci_energy_dressed(1)) + call save_wavefunction + else + E_new = 0.d0 + delta_E = 1.d0 + iteration = 0 + lambda = 1.d0 + do while (delta_E > thresh_dress) + iteration += 1 + print *, '===============================================' + print *, 'Iteration', iteration, '/', n_it_dress_max + print *, '===============================================' + print *, '' + E_old = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states)) + do i=1,N_st + call write_double(6,ci_energy_dressed(i),"Energy") + enddo + call diagonalize_ci_dressed(lambda) + E_new = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states)) + + delta_E = (E_new - E_old)/dble(N_states) + print *, '' + call write_double(6,thresh_dress,"thresh_dress") + call write_double(6,delta_E,"delta_E") + delta_E = dabs(delta_E) + call save_wavefunction + call ezfio_set_mrcepa0_energy(ci_energy_dressed(1)) + if (iteration >= n_it_dress_max) then + exit + endif + enddo + call write_double(6,ci_energy_dressed(1),"Final energy") + endif + energy(1:N_st) = ci_energy_dressed(1:N_st) +end + + +subroutine print_cas_coefs + implicit none + + integer :: i,j + print *, 'CAS' + print *, '===' + do i=1,N_det_cas + print *, (psi_cas_coef(i,j), j=1,N_states) + call debug_det(psi_cas(1,1,i),N_int) + enddo + call write_double(6,ci_energy(1),"Initial CI energy") + +end + + +subroutine run_pt2(N_st,energy) + implicit none + integer :: i,j,k + integer, intent(in) :: N_st + double precision, intent(in) :: energy(N_st) + double precision :: pt2(N_st) + double precision :: norm_pert(N_st),H_pert_diag(N_st) + + pt2 = 0d0 + + print*,'Last iteration only to compute the PT2' + + N_det_generators = N_det_cas + N_det_selectors = N_det_non_ref + + do i=1,N_det_generators + do k=1,N_int + psi_det_generators(k,1,i) = psi_ref(k,1,i) + psi_det_generators(k,2,i) = psi_ref(k,2,i) + enddo + do k=1,N_st + psi_coef_generators(i,k) = psi_ref_coef(i,k) + enddo + enddo + do i=1,N_det + do k=1,N_int + psi_selectors(k,1,i) = psi_det_sorted(k,1,i) + psi_selectors(k,2,i) = psi_det_sorted(k,2,i) + enddo + do k=1,N_st + psi_selectors_coef(i,k) = psi_coef_sorted(i,k) + enddo + enddo + + SOFT_TOUCH N_det_selectors psi_selectors_coef psi_selectors N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + SOFT_TOUCH psi_ref_coef_diagonalized psi_ref_energy_diagonalized + + call H_apply_mrcepa_PT2(pt2, norm_pert, H_pert_diag, N_st) + +! call ezfio_set_full_ci_energy_pt2(energy+pt2) + + print *, 'Final step' + print *, 'N_det = ', N_det + print *, 'N_states = ', N_states + print *, 'PT2 = ', pt2 + print *, 'E = ', energy + print *, 'E+PT2 = ', energy+pt2 + print *, '-----' + + call ezfio_set_mrcepa0_energy_pt2(energy(1)+pt2(1)) + +end + diff --git a/plugins/dress_zmq/dress_slave.irp.f b/plugins/dress_zmq/dress_slave.irp.f new file mode 100644 index 00000000..b699dd73 --- /dev/null +++ b/plugins/dress_zmq/dress_slave.irp.f @@ -0,0 +1,75 @@ +program dress_slave + implicit none + BEGIN_DOC +! Helper program to compute the dress in distributed mode. + END_DOC + read_wf = .False. + distributed_davidson = .False. + SOFT_TOUCH read_wf distributed_davidson + call provide_everything + call switch_qp_run_to_master + call run_wf +end + +subroutine provide_everything + PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context +end + +subroutine run_wf + use f77_zmq + implicit none + + integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + double precision :: energy(N_states_diag) + character*(64) :: states(1) + integer :: rc, i + + call provide_everything + + zmq_context = f77_zmq_ctx_new () + states(1) = 'dress' + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + + do + + call wait_for_states(states,zmq_state,1) + + if(trim(zmq_state) == 'Stopped') then + + exit + + else if (trim(zmq_state) == 'dress') then + + ! Selection + ! --------- + + print *, 'dress' + call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states) + + PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique + PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns + PROVIDE psi_bilinear_matrix_transp_order + + !$OMP PARALLEL PRIVATE(i) + i = omp_get_thread_num() + call dress_slave_tcp(i, energy) + !$OMP END PARALLEL + print *, 'dress done' + + endif + + end do +end + +subroutine dress_slave_tcp(i,energy) + implicit none + double precision, intent(in) :: energy(N_states_diag) + integer, intent(in) :: i + logical :: lstop + lstop = .False. + call run_dress_slave(0,i,energy,lstop) +end + diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f new file mode 100644 index 00000000..a6f2630a --- /dev/null +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -0,0 +1,617 @@ +BEGIN_PROVIDER [ integer, fragment_first ] + implicit none + fragment_first = first_det_of_teeth(1) +END_PROVIDER + + +subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) + use f77_zmq + + implicit none + + character(len=64000) :: task + + integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull + integer, external :: omp_get_thread_num + double precision, intent(in) :: relative_error, E + double precision, intent(out) :: dress(N_states) + double precision, intent(out) :: delta(N_states, N_det_non_ref) + double precision, intent(out) :: delta_s2(N_states, N_det_non_ref) + + + integer :: i, j, k, Ncp + + double precision, external :: omp_get_wtime + double precision :: time + double precision :: w(N_states) + integer, external :: add_task_to_taskserver + + + provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral dress_weight psi_selectors + + !!!!!!!!!!!!!!! demander a TOTO !!!!!!! + w(:) = 0.d0 + w(dress_stoch_istate) = 1.d0 + call update_psi_average_norm_contrib(w) + + + + + print *, '========== ================= ================= =================' + print *, ' Samples Energy Stat. Error Seconds ' + print *, '========== ================= ================= =================' + + + call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull, 'dress') + + integer, external :: zmq_put_psi + integer, external :: zmq_put_N_det_generators + integer, external :: zmq_put_N_det_selectors + integer, external :: zmq_put_dvector + integer, external :: zmq_set_running + if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then + stop 'Unable to put psi on ZMQ server' + endif + if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_generators on ZMQ server' + endif + if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_selectors on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',dress_e0_denominator,size(dress_e0_denominator)) == -1) then + stop 'Unable to put energy on ZMQ server' + endif + + integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket + integer :: ipos + ipos=1 + do i=1,N_dress_jobs + if(dress_jobs(i) > fragment_first) then + write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') 0, dress_jobs(i) + ipos += 20 + if (ipos > 63980) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + + ipos=1 + endif + else + do j=1,fragment_count + write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') j, dress_jobs(i) + ipos += 20 + if (ipos > 63980) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + ipos=1 + endif + end do + end if + end do + if (ipos > 1) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + endif + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + + !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) & + !$OMP PRIVATE(i) + i = omp_get_thread_num() + if (i==0) then + call dress_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, dress) + else + call dress_slave_inproc(i) + endif + !$OMP END PARALLEL + call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'dress') + + print *, '========== ================= ================= =================' +end subroutine + + +subroutine dress_slave_inproc(i) + implicit none + integer, intent(in) :: i + + call run_dress_slave(1,i,dress_e0_denominator) +end + + + +subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, dress) + use f77_zmq + use bitmasks + implicit none + + + + integer(ZMQ_PTR), intent(in) :: zmq_socket_pull + + double precision, intent(in) :: relative_error, E + double precision, intent(out) :: dress(N_states) + double precision, allocatable :: cp(:,:,:,:) + + double precision, intent(out) :: delta(N_states, N_det_non_ref) + double precision, intent(out) :: delta_s2(N_states, N_det_non_ref) + double precision, allocatable :: delta_loc(:,:,:), delta_det(:,:,:,:) + double precision, allocatable :: dress_detail(:,:) + double precision :: dress_mwen(N_states) + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + + integer(ZMQ_PTR), external :: new_zmq_pull_socket + + integer :: more + integer :: i, j, k, i_state, N + integer :: task_id, ind + double precision, save :: time0 = -1.d0 + double precision :: time, timeLast, old_tooth + double precision, external :: omp_get_wtime + integer :: cur_cp, old_cur_cp + integer, allocatable :: parts_to_get(:) + logical, allocatable :: actually_computed(:) + integer :: total_computed + + delta = 0d0 + delta_s2 = 0d0 + allocate(delta_det(N_states, N_det_non_ref, 0:comb_teeth+1, 2)) + allocate(cp(N_states, N_det_non_ref, N_cp, 2), dress_detail(N_states, N_det_generators)) + allocate(delta_loc(N_states, N_det_non_ref, 2)) + dress_detail = 0d0 + delta_det = 0d0 + cp = 0d0 + total_computed = 0 + character*(512) :: task + + allocate(actually_computed(N_det_generators), parts_to_get(N_det_generators)) + + dress_mwen =0.d0 + + parts_to_get(:) = 1 + if(fragment_first > 0) then + do i=1,fragment_first + parts_to_get(i) = fragment_count + enddo + endif + + actually_computed = .false. + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + more = 1 + if (time0 < 0.d0) then + call wall_time(time0) + endif + timeLast = time0 + cur_cp = 0 + old_cur_cp = 0 + logical :: loop + loop = .true. + + pullLoop : do while (loop) + call pull_dress_results(zmq_socket_pull, ind, dress_mwen, delta_loc, task_id) + + dress_detail(:, ind) += dress_mwen(:) + do j=1,N_cp !! optimizable + if(cps(ind, j) > 0d0) then + if(tooth_of_det(ind) < cp_first_tooth(j)) stop "coef on supposedely deterministic det" + double precision :: fac + integer :: toothMwen + logical :: fracted + fac = cps(ind, j) / cps_N(j) * dress_weight_inv(ind) * comb_step + do k=1,N_det_non_ref + do i_state=1,N_states + cp(i_state,k,j,1) += delta_loc(i_state,k,1) * fac + cp(i_state,k,j,2) += delta_loc(i_state,k,2) * fac + end do + end do + end if + end do + toothMwen = tooth_of_det(ind) + fracted = (toothMwen /= 0) + if(fracted) fracted = (ind == first_det_of_teeth(toothMwen)) + + if(fracted) then + delta_det(:,:,toothMwen-1, 1) += delta_loc(:,:,1) * (1d0-fractage(toothMwen)) + delta_det(:,:,toothMwen-1, 2) += delta_loc(:,:,2) * (1d0-fractage(toothMwen)) + delta_det(:,:,toothMwen, 1) += delta_loc(:,:,1) * (fractage(toothMwen)) + delta_det(:,:,toothMwen, 2) += delta_loc(:,:,2) * (fractage(toothMwen)) + else + delta_det(:,:,toothMwen, 1) += delta_loc(:,:,1) + delta_det(:,:,toothMwen, 2) += delta_loc(:,:,2) + end if + + parts_to_get(ind) -= 1 + if(parts_to_get(ind) == 0) then + actually_computed(ind) = .true. + total_computed += 1 + end if + + + integer, external :: zmq_delete_tasks + if (zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,1,more) == -1) then + stop 'Unable to delete tasks' + endif + if(more == 0) loop = .false. + + time = omp_get_wtime() + + + if(time - timeLast > 1d0 .or. (.not. loop)) then + timeLast = time + cur_cp = N_cp + if(.not. actually_computed(dress_jobs(1))) cycle pullLoop + + do i=2,N_det_generators + if(.not. actually_computed(dress_jobs(i))) then + cur_cp = done_cp_at(i-1) + exit + end if + end do + if(cur_cp == 0) cycle pullLoop + + + double precision :: su, su2, eqt, avg, E0, val + integer, external :: zmq_abort + + su = 0d0 + su2 = 0d0 + + if(N_states > 1) stop "dress_stoch : N_states == 1" + do i=1, int(cps_N(cur_cp)) + call get_comb_val(comb(i), dress_detail, cur_cp, val) + su += val + su2 += val**2 + end do + avg = su / cps_N(cur_cp) + eqt = dsqrt( ((su2 / cps_N(cur_cp)) - avg**2) / cps_N(cur_cp) ) + E0 = sum(dress_detail(1, :first_det_of_teeth(cp_first_tooth(cur_cp))-1)) + if(cp_first_tooth(cur_cp) <= comb_teeth) then + E0 = E0 + dress_detail(1, first_det_of_teeth(cp_first_tooth(cur_cp))) * (1d0-fractage(cp_first_tooth(cur_cp))) + end if + call wall_time(time) + if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then + ! Termination + !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' +! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed + if (zmq_abort(zmq_to_qp_run_socket) == -1) then + call sleep(1) + if (zmq_abort(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Error in sending abort signal (2)' + endif + endif + else + if (cur_cp > old_cur_cp) then + old_cur_cp = cur_cp +! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed + !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' + endif + endif + end if + end do pullLoop + + if(total_computed == N_det_generators) then + delta = 0d0 + delta_s2 = 0d0 + do i=comb_teeth+1,0,-1 + delta += delta_det(:,:,i,1) + delta_s2 += delta_det(:,:,i,2) + end do + else + + delta = cp(:,:,cur_cp,1) + delta_s2 = cp(:,:,cur_cp,2) + do i=cp_first_tooth(cur_cp)-1,0,-1 + delta += delta_det(:,:,i,1) + delta_s2 += delta_det(:,:,i,2) + end do + + end if + dress(1) = E + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) +end subroutine + + +integer function dress_find(v, w, sze, imin, imax) + implicit none + integer, intent(in) :: sze, imin, imax + double precision, intent(in) :: v, w(sze) + integer :: i,l,h + integer, parameter :: block=64 + + l = imin + h = imax-1 + + do while(h-l >= block) + i = ishft(h+l,-1) + if(w(i+1) > v) then + h = i-1 + else + l = i+1 + end if + end do + !DIR$ LOOP COUNT (64) + do dress_find=l,h + if(w(dress_find) >= v) then + exit + end if + end do +end function + + + BEGIN_PROVIDER [ integer, gen_per_cp ] +&BEGIN_PROVIDER [ integer, comb_teeth ] +&BEGIN_PROVIDER [ integer, N_cps_max ] + implicit none + comb_teeth = 16 + N_cps_max = 32 + gen_per_cp = (N_det_generators / N_cps_max) + 1 + N_cps_max += 1 +END_PROVIDER + + + BEGIN_PROVIDER [ integer, N_cp ] +&BEGIN_PROVIDER [ double precision, cps_N, (N_cps_max) ] +&BEGIN_PROVIDER [ integer, cp_first_tooth, (N_cps_max) ] +&BEGIN_PROVIDER [ integer, done_cp_at, (N_det_generators) ] +&BEGIN_PROVIDER [ double precision, cps, (N_det_generators, N_cps_max) ] +&BEGIN_PROVIDER [ integer, N_dress_jobs ] +&BEGIN_PROVIDER [ integer, dress_jobs, (N_det_generators) ] +&BEGIN_PROVIDER [ double precision, comb, (N_det_generators) ] + implicit none + logical, allocatable :: computed(:) + integer :: i, j, last_full, dets(comb_teeth) + integer :: k, l, cur_cp, under_det(comb_teeth+1) + integer, allocatable :: iorder(:), first_cp(:) + + allocate(iorder(N_det_generators), first_cp(N_cps_max+1)) + allocate(computed(N_det_generators)) + first_cp = 1 + cps = 0d0 + cur_cp = 1 + done_cp_at = 0 + + computed = .false. + + N_dress_jobs = first_det_of_comb - 1 + do i=1, N_dress_jobs + dress_jobs(i) = i + computed(i) = .true. + end do + + l=first_det_of_comb + call RANDOM_NUMBER(comb) + do i=1,N_det_generators + comb(i) = comb(i) * comb_step + !DIR$ FORCEINLINE + call add_comb(comb(i), computed, cps(1, cur_cp), N_dress_jobs, dress_jobs) + + if(N_dress_jobs / gen_per_cp > (cur_cp-1) .or. N_dress_jobs == N_det_generators) then + first_cp(cur_cp+1) = N_dress_jobs + done_cp_at(N_dress_jobs) = cur_cp + cps_N(cur_cp) = dfloat(i) + if(N_dress_jobs /= N_det_generators) then + cps(:, cur_cp+1) = cps(:, cur_cp) + cur_cp += 1 + end if + + if (N_dress_jobs == N_det_generators) exit + end if + do while (computed(l)) + l=l+1 + enddo + k=N_dress_jobs+1 + dress_jobs(k) = l + computed(l) = .True. + N_dress_jobs = k + enddo + N_cp = cur_cp + if(N_dress_jobs /= N_det_generators .or. N_cp > N_cps_max) then + print *, N_dress_jobs, N_det_generators, N_cp, N_cps_max + stop "error in jobs creation" + end if + + cur_cp = 0 + do i=1,N_dress_jobs + if(done_cp_at(i) /= 0) cur_cp = done_cp_at(i) + done_cp_at(i) = cur_cp + end do + + + under_det = 0 + cp_first_tooth = 0 + do i=1,N_dress_jobs + do j=comb_teeth+1,1,-1 + if(dress_jobs(i) <= first_det_of_teeth(j)) then + under_det(j) = under_det(j) + 1 + if(under_det(j) == first_det_of_teeth(j))then + do l=done_cp_at(i)+1, N_cp + cps(:first_det_of_teeth(j)-1, l) = 0d0 + cp_first_tooth(l) = j + end do + cps(first_det_of_teeth(j), done_cp_at(i)+1) = & + cps(first_det_of_teeth(j), done_cp_at(i)+1) * fractage(j) + end if + else + exit + end if + end do + end do + cps(:, N_cp) = 0d0 + cp_first_tooth(N_cp) = comb_teeth+1 + + iorder = -1 + do i=1,N_cp-1 + call isort(dress_jobs(first_cp(i)+1:first_cp(i+1)),iorder,first_cp(i+1)-first_cp(i)) + end do +END_PROVIDER + + +subroutine get_comb_val(stato, detail, cur_cp, val) + implicit none + integer, intent(in) :: cur_cp + integer :: first + double precision, intent(in) :: stato, detail(N_states, N_det_generators) + double precision, intent(out) :: val + double precision :: curs + integer :: j, k + integer, external :: dress_find + + curs = 1d0 - stato + val = 0d0 + first = cp_first_tooth(cur_cp) + + do j = comb_teeth, first, -1 + !DIR$ FORCEINLINE + k = dress_find(curs, dress_cweight,size(dress_cweight), first_det_of_teeth(j), first_det_of_teeth(j+1)) + if(k == first_det_of_teeth(first)) then + val += detail(1, k) * dress_weight_inv(k) * comb_step * fractage(first) + else + val += detail(1, k) * dress_weight_inv(k) * comb_step + end if + + curs -= comb_step + end do +end subroutine + + +subroutine get_comb(stato, dets) + implicit none + double precision, intent(in) :: stato + integer, intent(out) :: dets(comb_teeth) + double precision :: curs + integer :: j + integer, external :: dress_find + + curs = 1d0 - stato + do j = comb_teeth, 1, -1 + !DIR$ FORCEINLINE + dets(j) = dress_find(curs, dress_cweight,size(dress_cweight), first_det_of_teeth(j), first_det_of_teeth(j+1)) + curs -= comb_step + end do +end subroutine + + +subroutine add_comb(com, computed, cp, N, tbc) + implicit none + double precision, intent(in) :: com + integer, intent(inout) :: N + double precision, intent(inout) :: cp(N_det_non_ref) + logical, intent(inout) :: computed(N_det_generators) + integer, intent(inout) :: tbc(N_det_generators) + integer :: i, k, l, dets(comb_teeth) + + !DIR$ FORCEINLINE + call get_comb(com, dets) + + k=N+1 + do i = 1, comb_teeth + l = dets(i) + cp(l) += 1d0 + if(.not.(computed(l))) then + tbc(k) = l + k = k+1 + computed(l) = .true. + end if + end do + N = k-1 +end subroutine + + + BEGIN_PROVIDER [ integer, dress_stoch_istate ] + implicit none + dress_stoch_istate = 1 + END_PROVIDER + + + BEGIN_PROVIDER [ double precision, dress_weight, (N_det_generators) ] +&BEGIN_PROVIDER [ double precision, dress_weight_inv, (N_det_generators) ] +&BEGIN_PROVIDER [ double precision, dress_cweight, (N_det_generators) ] +&BEGIN_PROVIDER [ double precision, dress_cweight_cache, (N_det_generators) ] +&BEGIN_PROVIDER [ double precision, fractage, (comb_teeth) ] +&BEGIN_PROVIDER [ double precision, comb_step ] +&BEGIN_PROVIDER [ integer, first_det_of_teeth, (comb_teeth+1) ] +&BEGIN_PROVIDER [ integer, first_det_of_comb ] +&BEGIN_PROVIDER [ integer, tooth_of_det, (N_det_generators) ] + implicit none + integer :: i + double precision :: norm_left, stato + integer, external :: dress_find + + dress_weight(1) = psi_coef_generators(1,dress_stoch_istate)**2 + dress_cweight(1) = psi_coef_generators(1,dress_stoch_istate)**2 + + do i=1,N_det_generators + dress_weight(i) = psi_coef_generators(i,dress_stoch_istate)**2 + enddo + + ! Important to loop backwards for numerical precision + dress_cweight(N_det_generators) = dress_weight(N_det_generators) + do i=N_det_generators-1,1,-1 + dress_cweight(i) = dress_weight(i) + dress_cweight(i+1) + end do + + do i=1,N_det_generators + dress_weight(i) = dress_weight(i) / dress_cweight(1) + dress_cweight(i) = dress_cweight(i) / dress_cweight(1) + enddo + + do i=1,N_det_generators-1 + dress_cweight(i) = 1.d0 - dress_cweight(i+1) + end do + dress_cweight(N_det_generators) = 1.d0 + + norm_left = 1d0 + + comb_step = 1d0/dfloat(comb_teeth) + first_det_of_comb = 1 + do i=1,N_det_generators + if(dress_weight(i)/norm_left < .25d0*comb_step) then + first_det_of_comb = i + exit + end if + norm_left -= dress_weight(i) + end do + first_det_of_comb = max(2,first_det_of_comb) + call write_int(6, first_det_of_comb-1, 'Size of deterministic set') + + + comb_step = (1d0 - dress_cweight(first_det_of_comb-1)) * comb_step + + stato = 1d0 - comb_step + iloc = N_det_generators + do i=comb_teeth, 1, -1 + integer :: iloc + iloc = dress_find(stato, dress_cweight, N_det_generators, 1, iloc) + first_det_of_teeth(i) = iloc + fractage(i) = (dress_cweight(iloc) - stato) / dress_weight(iloc) + stato -= comb_step + end do + first_det_of_teeth(comb_teeth+1) = N_det_generators + 1 + first_det_of_teeth(1) = first_det_of_comb + + + if(first_det_of_teeth(1) /= first_det_of_comb) then + print *, 'Error in ', irp_here + stop "comb provider" + endif + + do i=1,N_det_generators + dress_weight_inv(i) = 1.d0/dress_weight(i) + enddo + + tooth_of_det(:first_det_of_teeth(1)-1) = 0 + do i=1,comb_teeth + tooth_of_det(first_det_of_teeth(i):first_det_of_teeth(i+1)-1) = i + end do +END_PROVIDER + + + + + + + diff --git a/plugins/dress_zmq/dress_zmq.irp.f b/plugins/dress_zmq/dress_zmq.irp.f new file mode 100644 index 00000000..1b06b391 --- /dev/null +++ b/plugins/dress_zmq/dress_zmq.irp.f @@ -0,0 +1,24 @@ +program dress_zmq + implicit none + double precision, allocatable :: energy(:) + allocate (energy(N_states)) + + read_wf = .True. + SOFT_TOUCH read_wf + call set_generators_bitmasks_as_holes_and_particles + if (.True.) then + integer :: i,j + do j=1,N_states + do i=1,N_det + psi_coef(i,j) = CI_eigenvectors(i,j) + enddo + enddo + SOFT_TOUCH psi_coef + endif + call run(N_states,energy) + if(do_pt2)then + call run_pt2(N_states,energy) + endif + deallocate(energy) +end + diff --git a/plugins/dress_zmq/dressing.irp.f b/plugins/dress_zmq/dressing.irp.f new file mode 100644 index 00000000..34c9a33d --- /dev/null +++ b/plugins/dress_zmq/dressing.irp.f @@ -0,0 +1,109 @@ +use bitmasks + + +BEGIN_PROVIDER [ integer, N_dress_teeth ] + N_dress_teeth = 10 +END_PROVIDER + +BEGIN_PROVIDER [ double precision, dress_norm_acc, (0:N_det_non_ref, N_states) ] +&BEGIN_PROVIDER [ double precision, dress_norm, (0:N_det_non_ref, N_states) ] +&BEGIN_PROVIDER [ double precision, dress_teeth_size, (0:N_det_non_ref, N_states) ] +&BEGIN_PROVIDER [ integer, dress_teeth, (0:N_dress_teeth+1, N_states) ] + implicit none + integer :: i, j, st, nt + double precision :: norm_sto, jump, norm_mwen, norm_loc + + if(N_states /= 1) stop "dress_sto may not work with N_states /= 1" + + do st=1,N_states + dress_teeth(0,st) = 1 + norm_sto = 1d0 + do i=1,N_det + dress_teeth(1,st) = i + jump = (1d0 / dfloat(N_dress_teeth)) * norm_sto + if(psi_coef_generators(i,1)**2 < jump / 2d0) exit + norm_sto -= psi_coef_generators(i,1)**2 + end do + + norm_loc = 0d0 + dress_norm_acc(0,st) = 0d0 + nt = 1 + + do i=1,dress_teeth(1,st)-1 + dress_norm_acc(i,st) = dress_norm_acc(i-1,st) + psi_coef_generators(i,st)**2 + end do + + do i=dress_teeth(1,st), N_det_generators!-dress_teeth(1,st)+1 + norm_mwen = psi_coef_generators(i,st)**2!-1+dress_teeth(1,st),st)**2 + dress_norm_acc(i,st) = dress_norm_acc(i-1,st) + norm_mwen + norm_loc += norm_mwen + if(norm_loc > (jump*dfloat(nt))) then + nt = nt + 1 + dress_teeth(nt,st) = i + end if + end do + if(nt > N_dress_teeth+1) then + print *, "foireouse dress_teeth", nt, dress_teeth(nt,st), N_det_non_ref + stop + end if + + dress_teeth(N_dress_teeth+1,st) = N_det_non_ref+1 + norm_loc = 0d0 + do i=N_dress_teeth, 0, -1 + dress_teeth_size(i,st) = dress_norm_acc(dress_teeth(i+1,st)-1,st) - dress_norm_acc(dress_teeth(i,st)-1, st) + dress_norm_acc(dress_teeth(i,st):dress_teeth(i+1,st)-1,st) -= dress_norm_acc(dress_teeth(i,st)-1, st) + dress_norm_acc(dress_teeth(i,st):dress_teeth(i+1,st)-1,st) = & + dress_norm_acc(dress_teeth(i,st):dress_teeth(i+1,st)-1,st) / dress_teeth_size(i,st) + dress_norm(dress_teeth(i,st), st) = dress_norm_acc(dress_teeth(i,st), st) + do j=dress_teeth(i,st)+1, dress_teeth(i+1,1)-1 + dress_norm(j,1) = dress_norm_acc(j, st) - dress_norm_acc(j-1, st) + end do + end do + end do +END_PROVIDER + + + + BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det_non_ref, N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii, (N_states, N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2, (N_states,N_det_non_ref, N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii_s2, (N_states, N_det_ref) ] + use bitmasks + implicit none + + integer :: i,j,k + + double precision, allocatable :: dress(:), del(:,:), del_s2(:,:) + double precision :: E_CI_before, relative_error + double precision, save :: errr = 0d0 + + allocate(dress(N_states), del(N_states, N_det_non_ref), del_s2(N_states, N_det_non_ref)) + + + delta_ij = 0d0 + delta_ii = 0d0 + delta_ij_s2 = 0d0 + delta_ii_s2 = 0d0 + + E_CI_before = dress_E0_denominator(1) + nuclear_repulsion + threshold_selectors = 1.d0 + threshold_generators = 1d0 + if(errr /= 0d0) then + errr = errr / 2d0 ! + else + errr = 1d-4 + end if + relative_error = errr + print *, "RELATIVE ERROR", relative_error + call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error)) + + delta_ij(:,:,1) = del(:,:) + delta_ij_s2(:,:,1) = del_s2(:,:) + do i=N_det_non_ref,1,-1 + delta_ii(dress_stoch_istate,1) -= delta_ij(dress_stoch_istate, i, 1) / psi_ref_coef(1,dress_stoch_istate) * psi_non_ref_coef(i, dress_stoch_istate) + delta_ii_s2(dress_stoch_istate,1) -= delta_ij_s2(dress_stoch_istate, i, 1) / psi_ref_coef(1,dress_stoch_istate) * psi_non_ref_coef(i, dress_stoch_istate) + end do +END_PROVIDER + + + diff --git a/plugins/dress_zmq/energy.irp.f b/plugins/dress_zmq/energy.irp.f new file mode 100644 index 00000000..0ab170f1 --- /dev/null +++ b/plugins/dress_zmq/energy.irp.f @@ -0,0 +1,23 @@ +BEGIN_PROVIDER [ logical, initialize_dress_E0_denominator ] + implicit none + BEGIN_DOC + ! If true, initialize dress_E0_denominator + END_DOC + initialize_dress_E0_denominator = .True. +END_PROVIDER + +BEGIN_PROVIDER [ double precision, dress_E0_denominator, (N_states) ] + implicit none + BEGIN_DOC + ! E0 in the denominator of the dress + END_DOC + if (initialize_dress_E0_denominator) then + dress_E0_denominator(1:N_states) = psi_energy(1:N_states) +! dress_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion +! dress_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) + call write_double(6,dress_E0_denominator(1)+nuclear_repulsion, 'dress Energy denominator') + else + dress_E0_denominator = -huge(1.d0) + endif +END_PROVIDER + diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f new file mode 100644 index 00000000..d8a5cbbe --- /dev/null +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -0,0 +1,174 @@ +BEGIN_PROVIDER [ integer, fragment_count ] + implicit none + BEGIN_DOC + ! Number of fragments for the deterministic part + END_DOC + fragment_count = 1 +END_PROVIDER + + +subroutine run_dress_slave(thread,iproc,energy) + use f77_zmq + implicit none + + double precision, intent(in) :: energy(N_states_diag) + integer, intent(in) :: thread, iproc + integer :: rc, i, subset, i_generator + + integer :: worker_id, task_id, ctask, ltask + character*(512) :: task + + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + + integer(ZMQ_PTR), external :: new_zmq_push_socket + integer(ZMQ_PTR) :: zmq_socket_push + + logical :: done + + double precision,allocatable :: dress_detail(:) + integer :: ind + + integer(bit_kind),allocatable :: abuf(:,:,:) + integer(bit_kind) :: mask(N_int,2), omask(N_int,2) + + double precision,allocatable :: delta_ij_loc(:,:,:) + double precision,allocatable :: delta_ii_loc(:,:) + integer :: h,p,n + logical :: ok + double precision :: contrib(N_states) + + allocate(delta_ij_loc(N_states,N_det_non_ref,2) & + ,delta_ii_loc(N_states,2)) + allocate(abuf(N_int, 2, N_det_non_ref)) + allocate(dress_detail(N_states)) + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + zmq_socket_push = new_zmq_push_socket(thread) + call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) + if(worker_id == -1) then + print *, "WORKER -1" + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + call end_zmq_push_socket(zmq_socket_push,thread) + return + end if + dress_detail = 0d0 + do + call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) + + if(task_id /= 0) then + read (task,*) subset, i_generator + contrib = 0d0 + delta_ij_loc = 0d0 + delta_ii_loc = 0d0 + do h=1, hh_shortcut(0) + call apply_hole_local(psi_det_generators(1,1,i_generator), hh_exists(1, h), mask, ok, N_int) + if(.not. ok) cycle + omask = 0_bit_kind + if(hh_exists(1, h) /= 0) omask = mask + n = 1 + do p=hh_shortcut(h), hh_shortcut(h+1)-1 + call apply_particle_local(mask, pp_exists(1, p), abuf(1,1,n), ok, N_int) + if(ok) n = n + 1 + if(n > N_det_non_ref) stop "Buffer too small in dress..." + end do + n = n - 1 + + if(n /= 0) then + n = n + 1 + n = n - 1 + !! DRESS HERE !! + !call dress_part_dress_1c(delta_ij_loc(1,1,1), delta_ii_loc(1,1), delta_ij_loc(1,1,2), delta_ii_loc(1,2), & + ! i_generator,n,abuf,N_int,omask,contrib) + endif + end do + dress_detail(:) = contrib + call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) + call push_dress_results(zmq_socket_push, i_generator, dress_detail, delta_ij_loc(1,1,1), task_id) + dress_detail(:) = 0d0 + else + exit + end if + end do + call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + call end_zmq_push_socket(zmq_socket_push,thread) +end subroutine + + +subroutine push_dress_results(zmq_socket_push, ind, dress_detail, delta_loc, task_id) + use f77_zmq + implicit none + + integer(ZMQ_PTR), intent(in) :: zmq_socket_push + double precision, intent(in) :: dress_detail(N_states, N_det_generators) + double precision, intent(in) :: delta_loc(N_states, N_det_non_ref, 2) + integer, intent(in) :: ind, task_id + integer :: rc, i + + + rc = f77_zmq_send( zmq_socket_push, ind, 4, ZMQ_SNDMORE) + if(rc /= 4) stop "push" + + + rc = f77_zmq_send( zmq_socket_push, dress_detail, 8*N_states, ZMQ_SNDMORE) + if(rc /= 8*N_states) stop "push" + + rc = f77_zmq_send( zmq_socket_push, delta_loc(1,1,1), 8*N_states*N_det_non_ref, ZMQ_SNDMORE) + if(rc /= 8*N_states*N_det_non_ref) stop "push" + + rc = f77_zmq_send( zmq_socket_push, delta_loc(1,1,2), 8*N_states*N_det_non_ref, ZMQ_SNDMORE) + if(rc /= 8*N_states*N_det_non_ref) stop "push" + + + rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0) + if(rc /= 4) stop "push" + +! Activate is zmq_socket_push is a REQ +IRP_IF ZMQ_PUSH +IRP_ELSE + character*(2) :: ok + rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0) +IRP_ENDIF + +end subroutine + + +subroutine pull_dress_results(zmq_socket_pull, ind, dress_detail, delta_loc, task_id) + use f77_zmq + implicit none + integer(ZMQ_PTR), intent(in) :: zmq_socket_pull + double precision, intent(inout) :: dress_detail(N_states) + double precision, intent(inout) :: delta_loc(N_states, N_det_non_ref, 2) + double precision, allocatable :: dress_dress_mwen(:,:) + integer, intent(out) :: ind + integer, intent(out) :: task_id + integer :: rc, rn, i + + allocate(dress_dress_mwen(N_states, N_det_non_ref)) + + rc = f77_zmq_recv( zmq_socket_pull, ind, 4, 0) + if(rc /= 4) stop "pull" + + rc = f77_zmq_recv( zmq_socket_pull, dress_detail, N_states*8, 0) + if(rc /= 8*N_states) stop "pull" + + rc = f77_zmq_recv( zmq_socket_pull, delta_loc(1,1,1), N_states*8*N_det_non_ref, 0) + if(rc /= 8*N_states*N_det_non_ref) stop "pull" + + rc = f77_zmq_recv( zmq_socket_pull, delta_loc(1,1,2), N_states*8*N_det_non_ref, 0) + if(rc /= 8*N_states*N_det_non_ref) stop "pull" + + rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0) + if(rc /= 4) stop "pull" + +! Activate is zmq_socket_pull is a REP +IRP_IF ZMQ_PUSH +IRP_ELSE + rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0) +IRP_ENDIF + +end subroutine + + + From 863782ab7929805d515e6073a0296fbe55020f31 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 9 Jan 2018 10:41:45 +0100 Subject: [PATCH 03/65] fixed merge --- plugins/dress_zmq/dress_zmq.irp.f | 2 +- plugins/mrcepa0/dressing.irp.f | 14 ++--- .../{mrcc_sto.irp.f => mrcc_omp.irp.f} | 0 plugins/mrcepa0/mrcc_stoch.irp.f | 8 ++- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 58 +++++++++---------- 5 files changed, 39 insertions(+), 43 deletions(-) rename plugins/mrcepa0/{mrcc_sto.irp.f => mrcc_omp.irp.f} (100%) diff --git a/plugins/dress_zmq/dress_zmq.irp.f b/plugins/dress_zmq/dress_zmq.irp.f index 1b06b391..a18bc882 100644 --- a/plugins/dress_zmq/dress_zmq.irp.f +++ b/plugins/dress_zmq/dress_zmq.irp.f @@ -1,4 +1,4 @@ -program dress_zmq +subroutine dress_zmq() implicit none double precision, allocatable :: energy(:) allocate (energy(N_states)) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 5dfa8556..f385c16a 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -910,8 +910,8 @@ end integer :: i,j,k double precision, allocatable :: mrcc(:) - double precision :: E_CI_before, relative_error - double precision, save :: errr = 0d0 + double precision :: E_CI_before!, relative_error + double precision, save :: target_error = 0d0 allocate(mrcc(N_states)) @@ -925,14 +925,12 @@ end E_CI_before = mrcc_E0_denominator(1) + nuclear_repulsion threshold_selectors = 1.d0 threshold_generators = 1d0 - if(errr /= 0d0) then - errr = errr / 2d0 ! (-mrcc_E0_denominator(1) + mrcc_previous_E(1)) / 1d1 + if(target_error /= 0d0) then + target_error = target_error / 2d0 ! (-mrcc_E0_denominator(1) + mrcc_previous_E(1)) / 1d1 else - errr = 1d-4 + target_error = 1d-4 end if - relative_error = errr - print *, "RELATIVE ERROR", relative_error - call ZMQ_mrcc(E_CI_before, mrcc, delta_ij_mrcc_zmq, delta_ij_s2_mrcc_zmq, abs(relative_error)) + call ZMQ_mrcc(E_CI_before, mrcc, delta_ij_mrcc_zmq, delta_ij_s2_mrcc_zmq, abs(target_error)) mrcc_previous_E(:) = mrcc_E0_denominator(:) do i=N_det_non_ref,1,-1 diff --git a/plugins/mrcepa0/mrcc_sto.irp.f b/plugins/mrcepa0/mrcc_omp.irp.f similarity index 100% rename from plugins/mrcepa0/mrcc_sto.irp.f rename to plugins/mrcepa0/mrcc_omp.irp.f diff --git a/plugins/mrcepa0/mrcc_stoch.irp.f b/plugins/mrcepa0/mrcc_stoch.irp.f index 7a11d292..c0c705a6 100644 --- a/plugins/mrcepa0/mrcc_stoch.irp.f +++ b/plugins/mrcepa0/mrcc_stoch.irp.f @@ -15,17 +15,21 @@ subroutine run integer :: degree integer :: n_det_before, to_select double precision :: threshold_davidson_in - double precision :: E_CI_before, relative_error + double precision, allocatable :: delta(:,:), delta_s2(:,:) + allocate (mrcc(N_states)) + allocate(delta(N_states, N_det_non_ref), delta_s2(N_states, N_det_non_ref)) mrcc = 0.d0 + delta = 0d0 + delta_s2 = 0d0 !call random_seed() E_CI_before = mrcc_E0_denominator(1) + nuclear_repulsion threshold_selectors = 1.d0 threshold_generators = 1d0 relative_error = 5.d-2 - call ZMQ_mrcc(E_CI_before, mrcc, relative_error) + call ZMQ_mrcc(E_CI_before, mrcc, delta, delta_s2, relative_error) !print *, 'Final step' !print *, 'N_det = ', N_det print *, 'mrcc = ', mrcc diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index a6c893b4..23f20a2e 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -158,14 +158,15 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m integer, allocatable :: task_id(:) integer :: Nindex integer, allocatable :: ind(:) - double precision, save :: time0 = -1.d0 - double precision :: time, timeLast, old_tooth + !double precision, save :: time0 = -1.d0 + double precision :: time, time0, timeInit, old_tooth double precision, external :: omp_get_wtime integer :: cur_cp, old_cur_cp integer, allocatable :: parts_to_get(:) logical, allocatable :: actually_computed(:) integer :: total_computed - + + print *, "TARGET ERROR :", relative_error delta = 0d0 delta_s2 = 0d0 allocate(delta_det(N_states, N_det_non_ref, 0:comb_teeth+1, 2)) @@ -195,10 +196,9 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m !zmq_socket_pull = new_zmq_pull_socket() allocate(task_id(N_det_generators), ind(1)) more = 1 - if (time0 < 0.d0) then - call wall_time(time0) - endif - timeLast = time0 + time = omp_get_wtime() + time0 = time + timeInit = time cur_cp = 0 old_cur_cp = 0 pullLoop : do while (more == 1) @@ -256,19 +256,25 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m - if(time - timeLast > 1d0 .or. more /= 1) then - timeLast = time + if(time - time0 > 10d0 .or. more /= 1) then + time0 = time cur_cp = N_cp - if(.not. actually_computed(mrcc_jobs(1))) cycle pullLoop + !if(.not. actually_computed(mrcc_jobs(1))) cycle pullLoop - do i=2,N_det_generators + do i=1,N_det_generators if(.not. actually_computed(mrcc_jobs(i))) then - cur_cp = done_cp_at(i-1) + if(i==1) then + cur_cp = 0 + else + cur_cp = done_cp_at(i-1) + end if exit end if end do - if(cur_cp == 0) cycle pullLoop - + if(cur_cp == 0) then + print *, "no checkpoint reached so far..." + cycle pullLoop + end if !!!!!!!!!!!! double precision :: su, su2, eqt, avg, E0, val integer, external :: zmq_abort @@ -278,12 +284,9 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m if(N_states > 1) stop "mrcc_stoch : N_states == 1" do i=1, int(cps_N(cur_cp)) - !if(.not. actually_computed(i)) stop "not computed" - !call get_comb_val(comb(i), mrcc_detail, cp_first_tooth(cur_cp), val) call get_comb_val(comb(i), mrcc_detail, cur_cp, val) - !val = mrcc_detail(1, i) * mrcc_weight_inv(i) * comb_step - su += val ! cps(i, cur_cp) * val - su2 += val**2 ! cps(i, cur_cp) * val**2 + su += val + su2 += val**2 end do avg = su / cps_N(cur_cp) eqt = dsqrt( ((su2 / cps_N(cur_cp)) - avg**2) / cps_N(cur_cp) ) @@ -291,25 +294,16 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m if(cp_first_tooth(cur_cp) <= comb_teeth) then E0 = E0 + mrcc_detail(1, first_det_of_teeth(cp_first_tooth(cur_cp))) * (1d0-fractage(cp_first_tooth(cur_cp))) end if - call wall_time(time) - if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then - ! Termination - !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' -! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed + print "(I5,F15.7,F10.2,E12.4)", cur_cp, E+E0+avg, eqt, time-timeInit + + if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then if (zmq_abort(zmq_to_qp_run_socket) == -1) then call sleep(1) if (zmq_abort(zmq_to_qp_run_socket) == -1) then print *, irp_here, ': Error in sending abort signal (2)' endif endif - else - if (cur_cp > old_cur_cp) then - old_cur_cp = cur_cp -! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed - - !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' - endif endif end if end do pullLoop @@ -369,7 +363,7 @@ end function &BEGIN_PROVIDER [ integer, N_cps_max ] implicit none comb_teeth = 16 - N_cps_max = 32 + N_cps_max = 64 !comb_per_cp = 64 gen_per_cp = (N_det_generators / N_cps_max) + 1 N_cps_max += 1 From 5166768d963dc0ca1fc4718fdbd9d4b0140172e4 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 9 Jan 2018 13:29:34 +0100 Subject: [PATCH 04/65] merged stash --- plugins/dress_zmq/dress_slave.irp.f | 2 +- plugins/mrcepa0/mrcc_slave.irp.f | 15 +++++++++++++-- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 1 - 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/plugins/dress_zmq/dress_slave.irp.f b/plugins/dress_zmq/dress_slave.irp.f index 560f536d..0b742003 100644 --- a/plugins/dress_zmq/dress_slave.irp.f +++ b/plugins/dress_zmq/dress_slave.irp.f @@ -1,4 +1,4 @@ -subroutine dress_slave() +subroutine dress_slave implicit none BEGIN_DOC ! Helper program to compute the dress in distributed mode. diff --git a/plugins/mrcepa0/mrcc_slave.irp.f b/plugins/mrcepa0/mrcc_slave.irp.f index 83295985..655536ff 100644 --- a/plugins/mrcepa0/mrcc_slave.irp.f +++ b/plugins/mrcepa0/mrcc_slave.irp.f @@ -25,7 +25,11 @@ subroutine run_wf double precision :: energy(N_states_diag) character*(64) :: states(1) integer :: rc, i - + + integer, external :: zmq_get_dvector, zmq_get_N_det_generators + integer, external :: zmq_get_psi, zmq_get_N_det_selectors + integer, external :: zmq_get_N_states_diag + call provide_everything zmq_context = f77_zmq_ctx_new () @@ -47,7 +51,14 @@ subroutine run_wf ! --------- print *, 'mrcc' - call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states) + !call wall_time(t0) + if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle + if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle + if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle + if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) == -1) cycle + + !call wall_time(t1) + !call write_double(6,(t1-t0),'Broadcast time') PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index d97308e1..7205837a 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -75,7 +75,6 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) ! end do integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket - integer, external :: add_task_to_taskserver, zmq_set_running integer :: ipos ipos=1 do i=1,N_mrcc_jobs From 5d0dbb304a4848041f2235ccc0654644e7beaf63 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 11 Jan 2018 10:08:11 +0100 Subject: [PATCH 05/65] Memo --- plugins/Full_CI_ZMQ/selection.irp.f | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 81ff5795..378e51c4 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -623,6 +623,9 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int) min_e_pert = 0d0 +! double precision :: hij +! call i_h_j(psi_det_generators(1,1,i_generator), det, N_int, hij) + do istate=1,N_states delta_E = E0(istate) - Hii val = mat(istate, p1, p2) + mat(istate, p1, p2) @@ -633,7 +636,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d e_pert = 0.5d0 * (tmp - delta_E) pt2(istate) = pt2(istate) + e_pert min_e_pert = min(e_pert,min_e_pert) -! ci(istate) = e_pert / mat(istate, p1, p2) +! ci(istate) = e_pert / hij end do if(min_e_pert <= buf%mini) then From 045109056fcf70182766d733f741c66dbf556e4b Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Sat, 13 Jan 2018 01:55:54 +0100 Subject: [PATCH 06/65] bug with zmq_state --- config/ifort_mpi.cfg | 4 ++-- plugins/mrcepa0/mrcc_slave.irp.f | 7 ++----- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 1 - plugins/mrcepa0/run_mrcc_slave.irp.f | 3 +-- 4 files changed, 5 insertions(+), 10 deletions(-) diff --git a/config/ifort_mpi.cfg b/config/ifort_mpi.cfg index 735ffb68..f179dac6 100644 --- a/config/ifort_mpi.cfg +++ b/config/ifort_mpi.cfg @@ -31,8 +31,8 @@ OPENMP : 1 ; Append OpenMP flags # -ftz : Flushes denormal results to zero # [OPT] -FCFLAGS : -xAVX -O2 -ip -ftz -g -traceback - +FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g -traceback +# !xAVX # Profiling flags ################# # diff --git a/plugins/mrcepa0/mrcc_slave.irp.f b/plugins/mrcepa0/mrcc_slave.irp.f index 655536ff..6feb5877 100644 --- a/plugins/mrcepa0/mrcc_slave.irp.f +++ b/plugins/mrcepa0/mrcc_slave.irp.f @@ -38,19 +38,16 @@ subroutine run_wf zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() do - call wait_for_states(states,zmq_state,1) - - if(trim(zmq_state) == 'Stopped') then + if(zmq_state(1:7) == 'Stopped') then exit - else if (trim(zmq_state) == 'mrcc') then + else if (zmq_state(1:4) == 'mrcc') then ! Selection ! --------- - print *, 'mrcc' !call wall_time(t0) if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index 7e68f53f..e83dfe15 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -209,7 +209,6 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m old_cur_cp = 0 pullLoop : do while (more == 1) call pull_mrcc_results(zmq_socket_pull, Nindex, ind, mrcc_mwen, delta_loc, task_id, ntask) - if(Nindex /= 1) stop "tried pull multiple Nindex" do i=1,Nindex diff --git a/plugins/mrcepa0/run_mrcc_slave.irp.f b/plugins/mrcepa0/run_mrcc_slave.irp.f index 3b3cfe44..523ad538 100644 --- a/plugins/mrcepa0/run_mrcc_slave.irp.f +++ b/plugins/mrcepa0/run_mrcc_slave.irp.f @@ -41,7 +41,6 @@ subroutine run_mrcc_slave(thread,iproc,energy) integer :: h,p,n logical :: ok double precision :: contrib(N_states) - allocate(delta_ij_loc(N_states,N_det_non_ref,2) & ,delta_ii_loc(N_states,2))! & !,delta_ij_s2_loc(N_states,N_det_non_ref,N_det_ref) & @@ -73,7 +72,7 @@ subroutine run_mrcc_slave(thread,iproc,energy) else integer :: i_generator, i_i_generator, subset read (task,*) subset, ind - + print *, "SLAVE RECEIVED", ind ! if(buf%N == 0) then ! ! Only first time ! call create_selection_buffer(1, 2, buf) From 02161df6d0078ef3c7a40d0433e5bb10c67b0a69 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 13 Jan 2018 18:15:12 +0100 Subject: [PATCH 07/65] Fixes #223 --- plugins/read_integral/NEEDED_CHILDREN_MODULES | 2 +- .../read_integral/print_integrals_mo.irp.f | 14 ++++---- plugins/read_integral/read_integrals_mo.irp.f | 36 +++++++++++++++++++ 3 files changed, 43 insertions(+), 9 deletions(-) diff --git a/plugins/read_integral/NEEDED_CHILDREN_MODULES b/plugins/read_integral/NEEDED_CHILDREN_MODULES index e492a3ce..566762ba 100644 --- a/plugins/read_integral/NEEDED_CHILDREN_MODULES +++ b/plugins/read_integral/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Integrals_Monoelec Integrals_Bielec +Integrals_Monoelec Integrals_Bielec Hartree_Fock diff --git a/plugins/read_integral/print_integrals_mo.irp.f b/plugins/read_integral/print_integrals_mo.irp.f index 45745c13..2381da52 100644 --- a/plugins/read_integral/print_integrals_mo.irp.f +++ b/plugins/read_integral/print_integrals_mo.irp.f @@ -44,14 +44,12 @@ program print_integrals do l=1,mo_tot_num do k=1,mo_tot_num do j=l,mo_tot_num - do i=k,mo_tot_num - if (i>=j) then - double precision :: get_mo_bielec_integral - integral = get_mo_bielec_integral(i,j,k,l,mo_integrals_map) - if (dabs(integral) > mo_integrals_threshold) then - write (iunit,'(4(I6,X),E25.15)') i,j,k,l, integral - endif - end if + do i=max(j,k),mo_tot_num + double precision :: get_mo_bielec_integral + integral = get_mo_bielec_integral(i,j,k,l,mo_integrals_map) + if (dabs(integral) > mo_integrals_threshold) then + write (iunit,'(4(I6,X),E25.15)') i,j,k,l, integral + endif enddo enddo enddo diff --git a/plugins/read_integral/read_integrals_mo.irp.f b/plugins/read_integral/read_integrals_mo.irp.f index a2d1cb6b..c021941c 100644 --- a/plugins/read_integral/read_integrals_mo.irp.f +++ b/plugins/read_integral/read_integrals_mo.irp.f @@ -5,8 +5,44 @@ program read_integrals ! - nuclear_mo ! - bielec_mo END_DOC + + integer :: iunit + integer :: getunitandopen + integer :: i,j,n + PROVIDE ezfio_filename call ezfio_set_integrals_monoelec_disk_access_mo_one_integrals("None") + + logical :: has + call ezfio_has_mo_basis_mo_tot_num(has) + if (.not.has) then + + iunit = getunitandopen('nuclear_mo','r') + n=0 + do + read (iunit,*,end=12) i + n = max(n,i) + enddo + 12 continue + close(iunit) + call ezfio_set_mo_basis_mo_tot_num(n) + + call ezfio_has_ao_basis_ao_num(has) + mo_label = "None" + if (has) then + call huckel_guess + else + call ezfio_set_ao_basis_ao_num(n) + double precision, allocatable :: X(:,:) + allocate (X(n,n)) + X = 0.d0 + do i=1,n + X(i,i) = 1.d0 + enddo + call ezfio_set_mo_basis_mo_coef(X) + call save_mos + endif + endif call run end From 35708de94457a19ec8111522ac91884e29c9379b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 22 Jan 2018 01:19:03 +0100 Subject: [PATCH 08/65] Upgrade to OCaml 4.06 and Core 0.10 --- README.md | 6 +++-- configure | 28 +++++++++++++--------- install/scripts/install_ocaml.sh | 5 ++-- ocaml/TaskServer.ml | 11 +++++---- ocaml/qp_create_ezfio_from_xyz.ml | 2 +- ocaml/qp_create_guess.ml | 2 +- ocaml/qp_find_pi_space.ml | 2 +- ocaml/qp_print.ml | 2 +- ocaml/qp_run.ml | 2 +- ocaml/qp_set_mo_class.ml | 2 +- scripts/ezfio_interface/upgrade_1.0_2.0.sh | 27 --------------------- scripts/qp_upgrade_ocaml.sh | 19 +++++++++++++++ 12 files changed, 55 insertions(+), 53 deletions(-) delete mode 100755 scripts/ezfio_interface/upgrade_1.0_2.0.sh create mode 100755 scripts/qp_upgrade_ocaml.sh diff --git a/README.md b/README.md index a11c5713..52f949c3 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,9 @@ ## IMPORTANT -If you have problems upgrading to the current version, consider re-installing everything from scratch including the OCaml compiler. -To do this, you will have to remove the `quantum_package` directory **and** the `$HOME/.opam` directory as well. +If you have problems upgrading to the current version, first try +`qp_upgrade_ocaml.sh`. If it fails, then consider re-installing everything from +scratch including the OCaml compiler. To do this, you will have to remove the +`quantum_package` directory **and** the `$HOME/.opam` directory as well. diff --git a/configure b/configure index 9b59b209..9f677e92 100755 --- a/configure +++ b/configure @@ -49,7 +49,7 @@ QP_ROOT_INSTALL = join(QP_ROOT, "install") os.environ["PATH"] = os.environ["PATH"] + ":" + QP_ROOT_BIN d_dependency = { - "ocaml": ["m4", "curl", "zlib", "patch", "gcc", "zeromq"], + "ocaml": ["m4", "curl", "zlib", "patch", "gcc", "zeromq", "gmp"], "m4": ["make"], "curl": ["make"], "zlib": ["gcc", "make"], @@ -67,7 +67,8 @@ d_dependency = { "ninja": ["g++", "python"], "make": [], "p_graphviz": ["python"], - "bats": [] + "bats": [], + "gmp" : ["make", "g++"] } from collections import namedtuple @@ -136,6 +137,11 @@ zeromq = Info( description=' ZeroMQ', default_path=join(QP_ROOT_LIB, "libzmq.a")) +gmp= Info( + url='https://gmplib.org/download/gmp/gmp-6.1.2.tar.bz2', + description=' The GNU Multiple Precision Arithmetic Library', + default_path=join(QP_ROOT_LIB, "libgmp.a")) + f77zmq = Info( url='{head}/zeromq/f77_zmq/{tail}'.format(**path_github), description=' F77-ZeroMQ', @@ -155,7 +161,7 @@ d_info = dict() for m in ["ocaml", "m4", "curl", "zlib", "patch", "irpf90", "docopt", "resultsFile", "ninja", "emsl", "ezfio", "p_graphviz", - "zeromq", "f77zmq", "bats"]: + "zeromq", "f77zmq", "bats", "gmp"]: exec ("d_info['{0}']={0}".format(m)) @@ -480,16 +486,16 @@ def create_ninja_and_rc(l_installed): 'export QP_PYTHON={0}'.format(":".join(l_python)), "", 'export IRPF90={0}'.format(path_irpf90.replace(QP_ROOT,"${QP_ROOT}")), 'export NINJA={0}'.format(path_ninja.replace(QP_ROOT,"${QP_ROOT}")), - 'function qp_append_export () {', - ' #Append path $2:${!1}. Add the semicolon only if ${!1} is defined', + 'function qp_prepend_export () {', + ' #Prepend path $2:${!1}. Add the semicolon only if ${!1} is defined', ' eval "value_1=\"\${$1}\""', - ' echo ${2}${value_1:+:${value_1}}', + ' echo ${value_1:+${value_1}:}${2}', '}', - 'export PYTHONPATH=$(qp_append_export "PYTHONPATH" "${QP_EZFIO}/Python":"${QP_PYTHON}")', - 'export PATH=$(qp_append_export "PATH" "${QP_PYTHON}":"${QP_ROOT}"/bin:"${QP_ROOT}"/ocaml)', - 'export LD_LIBRARY_PATH=$(qp_append_export "LD_LIBRARY_PATH" "${QP_ROOT}"/lib:"${QP_ROOT}"/lib64)', - 'export LIBRARY_PATH=$(qp_append_export "LIBRARY_PATH" "${QP_ROOT}"/lib:"${QP_ROOT}"/lib64)', - 'export C_INCLUDE_PATH=$(qp_append_export "C_INCLUDE_PATH" "${QP_ROOT}"/include)', + 'export PYTHONPATH=$(qp_prepend_export "PYTHONPATH" "${QP_EZFIO}/Python":"${QP_PYTHON}")', + 'export PATH=$(qp_prepend_export "PATH" "${QP_PYTHON}":"${QP_ROOT}"/bin:"${QP_ROOT}"/ocaml)', + 'export LD_LIBRARY_PATH=$(qp_prepend_export "LD_LIBRARY_PATH" "${QP_ROOT}"/lib:"${QP_ROOT}"/lib64)', + 'export LIBRARY_PATH=$(qp_prepend_export "LIBRARY_PATH" "${QP_ROOT}"/lib:"${QP_ROOT}"/lib64)', + 'export C_INCLUDE_PATH=$(qp_prepend_export "C_INCLUDE_PATH" "${QP_ROOT}"/include)', '', 'if [[ $SHELL == "bash" ]] ; then', ' source ${QP_ROOT}/install/EZFIO/Bash/ezfio.sh', diff --git a/install/scripts/install_ocaml.sh b/install/scripts/install_ocaml.sh index f322bd0b..9e8a2b25 100755 --- a/install/scripts/install_ocaml.sh +++ b/install/scripts/install_ocaml.sh @@ -5,11 +5,12 @@ QP_ROOT=$PWD cd - # Normal installation -PACKAGES="core.v0.9.1 cryptokit.1.10 ocamlfind sexplib.v0.9.1 ZMQ ppx_sexp_conv ppx_deriving" +PACKAGES="core.v0.10.0 cryptokit ocamlfind sexplib.v0.10.0 ZMQ ppx_sexp_conv ppx_deriving" # Needed for ZeroMQ export C_INCLUDE_PATH="${QP_ROOT}"/include:"${C_INCLUDE_PATH}" export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}" +export LDFLAGS="-L$QP_ROOT/lib" export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}" # return 0 if program version is equal or greater than check version @@ -64,7 +65,7 @@ fi cd Downloads || exit 1 chmod +x ocaml.sh || exit 1 -echo N | ./ocaml.sh ${QP_ROOT}/bin/ 4.04.2 || exit 1 +echo N | ./ocaml.sh ${QP_ROOT}/bin/ 4.06.0 || exit 1 ${QP_ROOT}/bin/opam config setup -a -q || exit 1 diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 31d6ab3b..170e011a 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -1,6 +1,7 @@ open Core open Qptypes +module StringHashtbl = Hashtbl.Make(String) type pub_state = | Waiting @@ -28,7 +29,7 @@ type t = progress_bar : Progress_bar.t option ; running : bool; accepting_clients : bool; - data : (string, string) Hashtbl.t; + data : string StringHashtbl.t; } @@ -208,7 +209,7 @@ let end_job msg program_state rep_socket pair_socket = address_inproc = None; running = true; accepting_clients = false; - data = Hashtbl.create ~hashable:String.hashable (); + data = StringHashtbl.create (); } and wait n = @@ -592,7 +593,7 @@ let put_data msg rest_of_msg program_state rep_socket = in let success () = - Hashtbl.set program_state.data ~key ~data:value ; + StringHashtbl.set program_state.data ~key ~data:value ; Message.PutDataReply (Message.PutDataReply_msg.create ()) |> Message.to_string |> ZMQ.Socket.send rep_socket; @@ -622,7 +623,7 @@ let get_data msg program_state rep_socket = let success () = let value = - match Hashtbl.find program_state.data key with + match StringHashtbl.find program_state.data key with | Some value -> value | None -> "" in @@ -776,7 +777,7 @@ let run ~port = address_inproc = None; progress_bar = None ; accepting_clients = false; - data = Hashtbl.create ~hashable:String.hashable (); + data = StringHashtbl.create (); } in diff --git a/ocaml/qp_create_ezfio_from_xyz.ml b/ocaml/qp_create_ezfio_from_xyz.ml index 93c8c8ff..737052ee 100644 --- a/ocaml/qp_create_ezfio_from_xyz.ml +++ b/ocaml/qp_create_ezfio_from_xyz.ml @@ -665,7 +665,7 @@ let run ?o b au c d m p cart xyz_file = let command = - Command.basic + Command.basic_spec ~summary: "Quantum Package command" ~readme:(fun () -> " diff --git a/ocaml/qp_create_guess.ml b/ocaml/qp_create_guess.ml index b841c350..71a5b296 100644 --- a/ocaml/qp_create_guess.ml +++ b/ocaml/qp_create_guess.ml @@ -128,7 +128,7 @@ let spec = +> anon ("ezfio_file" %: string) let () = - Command.basic + Command.basic_spec ~summary: "Quantum Package command" ~readme:( fun () -> " Creates an open-shell multiplet initial guess\n\n" ) diff --git a/ocaml/qp_find_pi_space.ml b/ocaml/qp_find_pi_space.ml index 0f5f7365..dcd671ce 100644 --- a/ocaml/qp_find_pi_space.ml +++ b/ocaml/qp_find_pi_space.ml @@ -95,7 +95,7 @@ let spec = let command = - Command.basic + Command.basic_spec ~summary: "Quantum Package command" ~readme:(fun () -> "Find all the pi molecular orbitals to create a pi space. diff --git a/ocaml/qp_print.ml b/ocaml/qp_print.ml index ea52bd7f..efbdc01e 100644 --- a/ocaml/qp_print.ml +++ b/ocaml/qp_print.ml @@ -141,7 +141,7 @@ let run_o ~action ezfio_filename = ;; let command = - Command.basic + Command.basic_spec ~summary: "Quantum Package command" ~readme:(fun () -> " diff --git a/ocaml/qp_run.ml b/ocaml/qp_run.ml index f426932b..f3f0b14e 100644 --- a/ocaml/qp_run.ml +++ b/ocaml/qp_run.ml @@ -150,7 +150,7 @@ let spec = let () = - Command.basic + Command.basic_spec ~summary: "Quantum Package command" ~readme:( fun () -> " Executes a Quantum Package binary file among these:\n\n" diff --git a/ocaml/qp_set_mo_class.ml b/ocaml/qp_set_mo_class.ml index ef2cc977..e12a2d75 100644 --- a/ocaml/qp_set_mo_class.ml +++ b/ocaml/qp_set_mo_class.ml @@ -323,7 +323,7 @@ let spec = let command = - Command.basic + Command.basic_spec ~summary: "Quantum Package command" ~readme:(fun () -> "Set the orbital classes in an EZFIO directory diff --git a/scripts/ezfio_interface/upgrade_1.0_2.0.sh b/scripts/ezfio_interface/upgrade_1.0_2.0.sh deleted file mode 100755 index ec0ab770..00000000 --- a/scripts/ezfio_interface/upgrade_1.0_2.0.sh +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/bash -# Convert a old ezfio file (with option.irp.f ezfio_default) -# into a new EZFIO.cfg type - -# Hartree Fock -# Changin the case, don't know if is needed or not -mv $1/Hartree_Fock $1/hartree_fock 2> /dev/null - -mv $1/hartree_Fock/thresh_SCF $1/hartree_fock/thresh_scf 2> /dev/null - -# BiInts -mv $1/bi_integrals $1/bielect_integrals 2> /dev/null - -if [ -f $1/bielect_integrals/read_ao_integrals ]; then - if [ `cat $1/bielect_integrals/read_ao_integrals` -eq "True" ] - then - echo "Read" > $1/bielect_integrals/disk_access_ao_integrals - - elif [ `cat bielect_integrals/write_ao_integrals` -eq "True" ] - then - echo "Write" > $1/bielect_integrals/disk_access_ao_integrals - - else - echo "None" > $1/bielect_integrals/disk_access_ao_integrals - - fi -fi \ No newline at end of file diff --git a/scripts/qp_upgrade_ocaml.sh b/scripts/qp_upgrade_ocaml.sh new file mode 100755 index 00000000..ad2156e9 --- /dev/null +++ b/scripts/qp_upgrade_ocaml.sh @@ -0,0 +1,19 @@ +#!/bin/bash + +OCAML_VERSION="4.06.0" +PACKAGES="core.v0.10.0 cryptokit ocamlfind sexplib.v0.10.0 ZMQ ppx_sexp_conv ppx_deriving" + +if [[ -z ${QP_ROOT} ]] +then + print "The QP_ROOT environment variable is not set." + print "Please reload the quantum_package.rc file." + exit -1 +fi + +cd $QP_ROOT/ocaml +opam update +opam switch ${OCAML_VERSION} +eval `opam config env` +opam install -y ${PACKAGES} || echo "Upgrade failed. You can try running +configure ; $0" + From cee0b40463849c06aec515014407d3155ced6c9b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 22 Jan 2018 01:46:46 +0100 Subject: [PATCH 10/65] Fixed qp_edit --- scripts/ezfio_interface/qp_edit_template | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/ezfio_interface/qp_edit_template b/scripts/ezfio_interface/qp_edit_template index 55a35f83..2e2c26c6 100644 --- a/scripts/ezfio_interface/qp_edit_template +++ b/scripts/ezfio_interface/qp_edit_template @@ -256,7 +256,7 @@ let spec = let command = - Command.basic + Command.basic_spec ~summary: "Quantum Package command" ~readme:(fun () -> " From f8924a82f4b0bf40596698911bf39099d66d454a Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 2 Feb 2018 13:10:14 +0100 Subject: [PATCH 11/65] reduced write on checkpoints --- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 221 ++++++++++++++-------- 1 file changed, 142 insertions(+), 79 deletions(-) diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index e83dfe15..fe6d38f1 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -110,16 +110,17 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) print *, irp_here, ': Failed in zmq_set_running' endif - !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) & - !$OMP PRIVATE(i) - i = omp_get_thread_num() - if (i==0) then - call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc) - - else - call mrcc_slave_inproc(i) - endif - !$OMP END PARALLEL + !!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) & + ! !$OMP PRIVATE(i) + !i = omp_get_thread_num() + !if (i==0) then + ! call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc) +! +! else +! call mrcc_slave_inproc(i) +! endif +! !$OMP END PARALLEL + call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc) call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'mrcc') print *, '========== ================= ================= =================' @@ -146,15 +147,14 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m integer(ZMQ_PTR), intent(in) :: zmq_socket_pull - double precision, intent(in) :: relative_error, E + double precision, intent(in) :: relative_error, E(N_states) double precision, intent(out) :: mrcc(N_states) double precision, allocatable :: cp(:,:,:,:) double precision, intent(out) :: delta(N_states, N_det_non_ref) double precision, intent(out) :: delta_s2(N_states, N_det_non_ref) - double precision, allocatable :: delta_loc(:,:,:), delta_det(:,:,:,:) + double precision, allocatable :: delta_loc(:,:,:,:), delta_det(:,:,:,:) double precision, allocatable :: mrcc_detail(:,:) - double precision :: mrcc_mwen(N_states) integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket @@ -164,7 +164,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m integer :: i, j, k, i_state, N, ntask integer, allocatable :: task_id(:) integer :: Nindex - integer, allocatable :: ind(:) + integer :: ind !double precision, save :: time0 = -1.d0 double precision :: time, time0, timeInit, old_tooth double precision, external :: omp_get_wtime @@ -172,13 +172,22 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m integer, allocatable :: parts_to_get(:) logical, allocatable :: actually_computed(:) integer :: total_computed - + integer, parameter :: delta_loc_N = 4 + integer :: delta_loc_slot, delta_loc_i(delta_loc_N) + double precision :: mrcc_mwen(N_states, delta_loc_N), lcoef(delta_loc_N) + logical :: ok + double precision :: usf, num + integer(8), save :: rezo = 0_8 + + usf = 0d0 + num = 0d0 + print *, "TARGET ERROR :", relative_error delta = 0d0 delta_s2 = 0d0 allocate(delta_det(N_states, N_det_non_ref, 0:comb_teeth+1, 2)) allocate(cp(N_states, N_det_non_ref, N_cp, 2), mrcc_detail(N_states, N_det_generators)) - allocate(delta_loc(N_states, N_det_non_ref, 2)) + allocate(delta_loc(N_states, N_det_non_ref, 2, delta_loc_N)) mrcc_detail = 0d0 delta_det = 0d0 !mrcc_detail = mrcc_detail / 0d0 @@ -200,69 +209,122 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m actually_computed = .false. zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - allocate(task_id(N_det_generators), ind(1)) + allocate(task_id(N_det_generators)) more = 1 time = omp_get_wtime() time0 = time timeInit = time cur_cp = 0 old_cur_cp = 0 + delta_loc_slot = 1 + delta_loc_i = 0 pullLoop : do while (more == 1) - call pull_mrcc_results(zmq_socket_pull, Nindex, ind, mrcc_mwen, delta_loc, task_id, ntask) + call pull_mrcc_results(zmq_socket_pull, Nindex, ind, mrcc_mwen(1, delta_loc_slot), delta_loc(1,1,1,delta_loc_slot), task_id, ntask) + !rezo += N_det_non_ref*8*2 + !print *, rezo / 1000000_8, "M" if(Nindex /= 1) stop "tried pull multiple Nindex" - - do i=1,Nindex - mrcc_detail(:, ind(i)) += mrcc_mwen(:) - do j=1,N_cp !! optimizable - if(cps(ind(i), j) > 0d0) then - if(tooth_of_det(ind(i)) < cp_first_tooth(j)) stop "coef on supposedely deterministic det" - double precision :: fac - integer :: toothMwen - logical :: fracted - fac = cps(ind(i), j) / cps_N(j) * mrcc_weight_inv(ind(i)) * comb_step - do k=1,N_det_non_ref - do i_state=1,N_states - cp(i_state,k,j,1) += delta_loc(i_state,k,1) * fac - cp(i_state,k,j,2) += delta_loc(i_state,k,2) * fac - end do - end do - end if - end do - toothMwen = tooth_of_det(ind(i)) - fracted = (toothMwen /= 0) - if(fracted) fracted = (ind(i) == first_det_of_teeth(toothMwen)) - - if(fracted) then - delta_det(:,:,toothMwen-1, 1) += delta_loc(:,:,1) * (1d0-fractage(toothMwen)) - delta_det(:,:,toothMwen-1, 2) += delta_loc(:,:,2) * (1d0-fractage(toothMwen)) - delta_det(:,:,toothMwen, 1) += delta_loc(:,:,1) * (fractage(toothMwen)) - delta_det(:,:,toothMwen, 2) += delta_loc(:,:,2) * (fractage(toothMwen)) - else - delta_det(:,:,toothMwen, 1) += delta_loc(:,:,1) - delta_det(:,:,toothMwen, 2) += delta_loc(:,:,2) - end if - - parts_to_get(ind(i)) -= 1 - if(parts_to_get(ind(i)) == 0) then - actually_computed(ind(i)) = .true. - !print *, "CONTRIB", ind(i), psi_non_ref_coef(ind(i),1), mrcc_detail(1, ind(i)) - total_computed += 1 - end if - end do - + delta_loc_i(delta_loc_slot) = ind integer, external :: zmq_delete_tasks if (zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,ntask,more) == -1) then stop 'Unable to delete tasks' endif - - + time = omp_get_wtime() - - - - if(time - time0 > 10d0 .or. more /= 1) then +!time - time0 > 10d0 + if(more /= 1 .or. delta_loc_slot == delta_loc_N) then time0 = time + do i=1,delta_loc_N + if(delta_loc_i(i) /= 0) then + mrcc_detail(:, delta_loc_i(i)) += mrcc_mwen(:,i) + end if + end do + + !$OMP PARALLEL DO SCHEDULE(DYNAMIC) DEFAULT(shared) private(j, ok, i, lcoef, k, i_state) + do j=1,N_cp !! optimizable + ok = .false. + do i=1,delta_loc_N + if(delta_loc_i(i) == 0) then + lcoef(i) = 0d0 + else + lcoef(i) = cps(delta_loc_i(i), j) / cps_N(j) * mrcc_weight_inv(delta_loc_i(i)) * comb_step + if(lcoef(i) /= 0d0) then + !usf = usf + 1d0 + ok = .true. + end if + end if + end do + if(.not. ok) cycle + !num += 1d0 + !print *, "USEFUL", usf, num, usf/num + !do j=1,N_cp !! optimizable + ! if(cps(ind, j) > 0d0) then + !if(tooth_of_det(ind) < cp_first_tooth(j)) stop "coef on supposedely deterministic det" + double precision :: fac + integer :: toothMwen + logical :: fracted, toothMwendid(0:10000) + !fac = cps(ind, j) / cps_N(j) * mrcc_weight_inv(ind) * comb_step + !!$OMP PARALLEL DO COLLAPSE(2) DEFAULT(shared) + do k=1,N_det_non_ref + do i_state=1,N_states + cp(i_state,k,j,1) += delta_loc(i_state,k,1,1) * lcoef(1) + & + delta_loc(i_state,k,1,2) * lcoef(2) + & + delta_loc(i_state,k,1,3) * lcoef(3) + & + delta_loc(i_state,k,1,4) * lcoef(4) + end do + end do + + !!$OMP PARALLEL DO COLLAPSE(2) DEFAULT(shared) + do k=1,N_det_non_ref + do i_state=1,N_states + cp(i_state,k,j,2) += delta_loc(i_state,k,2,1) * lcoef(1) + & + delta_loc(i_state,k,2,2) * lcoef(2) + & + delta_loc(i_state,k,2,3) * lcoef(3) + & + delta_loc(i_state,k,2,4) * lcoef(4) + end do + end do + + ! end if + end do + !$OMP END PARALLEL DO + + !toothmwendid = .false. + do i=1,delta_loc_N + ind = delta_loc_i(i) + if(ind == 0) cycle + toothMwen = tooth_of_det(ind) + !if(.not. toothmwendid(toothMwen)) then + ! usf += 1d0 + ! toothmwendid(toothMwen) = .true. + !end if + + fracted = (toothMwen /= 0) + if(fracted) fracted = (ind == first_det_of_teeth(toothMwen)) + + if(fracted) then + delta_det(:,:,toothMwen-1, 1) += delta_loc(:,:,1,i) * (1d0-fractage(toothMwen)) + delta_det(:,:,toothMwen-1, 2) += delta_loc(:,:,2,i) * (1d0-fractage(toothMwen)) + delta_det(:,:,toothMwen, 1) += delta_loc(:,:,1,i) * (fractage(toothMwen)) + delta_det(:,:,toothMwen, 2) += delta_loc(:,:,2,i) * (fractage(toothMwen)) + else + delta_det(:,:,toothMwen, 1) += delta_loc(:,:,1,i) + delta_det(:,:,toothMwen, 2) += delta_loc(:,:,2,i) + end if + parts_to_get(ind) -= 1 + if(parts_to_get(ind) == 0) then + actually_computed(ind) = .true. + !print *, "CONTRIB", ind, psi_non_ref_coef(ind,1), mrcc_detail(1, ind) + total_computed += 1 + end if + end do + !num += 1d0 + !print *, "USEFUL", usf, num, usf/num + + delta_loc_slot = 1 + delta_loc_i = 0 + + + !if(time - time0 > 10d0 .or. more /= 1) then cur_cp = N_cp !if(.not. actually_computed(mrcc_jobs(1))) cycle pullLoop @@ -300,7 +362,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m E0 = E0 + mrcc_detail(1, first_det_of_teeth(cp_first_tooth(cur_cp))) * (1d0-fractage(cp_first_tooth(cur_cp))) end if - print "(I5,F15.7,F10.2,E12.4)", cur_cp, E+E0+avg, eqt, time-timeInit + print "(I5,F15.7,E12.4,F10.2)", cur_cp, E+E0+avg, eqt, time-timeInit if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then if (zmq_abort(zmq_to_qp_run_socket) == -1) then @@ -310,6 +372,8 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m endif endif endif + else + delta_loc_slot += 1 end if end do pullLoop @@ -321,16 +385,14 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m delta_s2 += delta_det(:,:,i,2) end do else - - delta = cp(:,:,cur_cp,1) - delta_s2 = cp(:,:,cur_cp,2) - do i=cp_first_tooth(cur_cp)-1,0,-1 - delta += delta_det(:,:,i,1) - delta_s2 += delta_det(:,:,i,2) - end do - + delta = cp(:,:,cur_cp,1) + delta_s2 = cp(:,:,cur_cp,2) + do i=cp_first_tooth(cur_cp)-1,0,-1 + delta += delta_det(:,:,i,1) + delta_s2 += delta_det(:,:,i,2) + end do end if - mrcc(1) = E + mrcc = E call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) end subroutine @@ -389,6 +451,8 @@ END_PROVIDER integer :: i, j, last_full, dets(comb_teeth) integer :: k, l, cur_cp, under_det(comb_teeth+1) integer, allocatable :: iorder(:), first_cp(:) + double precision :: tmp + allocate(iorder(N_det_generators), first_cp(N_cps_max+1)) allocate(computed(N_det_generators)) @@ -468,11 +532,10 @@ END_PROVIDER cps(:, N_cp) = 0d0 cp_first_tooth(N_cp) = comb_teeth+1 - iorder = -1132154665 - do i=1,N_cp-1 - call isort(mrcc_jobs(first_cp(i)+1:first_cp(i+1)),iorder,first_cp(i+1)-first_cp(i)) - end do -! end subroutine + !iorder = -1132154665 + !do i=1,N_cp-1 + ! call isort(mrcc_jobs(first_cp(i)+1:first_cp(i+1)),iorder,first_cp(i+1)-first_cp(i)) + !end do END_PROVIDER From 5f6349e7ac3c79d1d1a109f1cc8bfb41969119b0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 8 Feb 2018 17:48:47 +0100 Subject: [PATCH 12/65] Generalized Davdison for dressed methods --- ocaml/Input_determinants_by_hand.ml | 12 +- plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES | 2 +- plugins/CID/NEEDED_CHILDREN_MODULES | 2 +- plugins/CID_selected/NEEDED_CHILDREN_MODULES | 2 +- plugins/CIS/NEEDED_CHILDREN_MODULES | 2 +- plugins/CISD/NEEDED_CHILDREN_MODULES | 2 +- plugins/Casino/NEEDED_CHILDREN_MODULES | 2 +- plugins/DavidsonDressed/README.rst | 14 + .../diagonalization_hs2_dressed.irp.f | 103 +- .../DavidsonUndressed/NEEDED_CHILDREN_MODULES | 1 + plugins/DavidsonUndressed/README.rst | 14 + .../DavidsonUndressed}/davidson_slave.irp.f | 0 .../diag_restart_save_all_states.irp.f | 0 .../diag_restart_save_lowest_state.irp.f | 0 .../diag_restart_save_one_state.irp.f | 0 .../guess_lowest_state.irp.f | 0 .../print_H_matrix_restart.irp.f | 0 .../DavidsonUndressed}/print_energy.irp.f | 0 plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES | 2 +- plugins/MRCC_Utils/H_apply.irp.f | 10 +- plugins/MRCC_Utils/davidson.irp.f | 1128 ----------------- plugins/MRCC_Utils/mrcc_dress.irp.f | 5 +- plugins/MRCC_Utils/mrcc_utils.irp.f | 204 --- plugins/MRCC_Utils/multi_state.irp.f | 101 -- plugins/Properties/NEEDED_CHILDREN_MODULES | 2 +- plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES | 2 +- .../UndressedMethod/NEEDED_CHILDREN_MODULES | 1 + plugins/UndressedMethod/README.rst | 14 + .../null_dressing_vector.irp.f | 10 + plugins/mrcepa0/NEEDED_CHILDREN_MODULES | 2 +- plugins/mrcepa0/dressing.irp.f | 424 ++----- plugins/mrcepa0/dressing_slave.irp.f | 52 +- plugins/mrcepa0/mrcepa0_general.irp.f | 8 +- plugins/mrcepa0/run_mrcc_slave.irp.f | 10 +- src/Davidson/NEEDED_CHILDREN_MODULES | 2 +- src/Davidson/diagonalize_CI.irp.f | 2 +- 36 files changed, 308 insertions(+), 1827 deletions(-) create mode 100644 plugins/DavidsonDressed/README.rst rename src/Davidson/diagonalization_hs2.irp.f => plugins/DavidsonDressed/diagonalization_hs2_dressed.irp.f (84%) create mode 100644 plugins/DavidsonUndressed/NEEDED_CHILDREN_MODULES create mode 100644 plugins/DavidsonUndressed/README.rst rename {src/Davidson => plugins/DavidsonUndressed}/davidson_slave.irp.f (100%) rename src/Davidson/diagonalize_restart_and_save_all_states.irp.f => plugins/DavidsonUndressed/diag_restart_save_all_states.irp.f (100%) rename src/Davidson/diagonalize_restart_and_save_lowest_state.irp.f => plugins/DavidsonUndressed/diag_restart_save_lowest_state.irp.f (100%) rename src/Davidson/diagonalize_restart_and_save_one_state.irp.f => plugins/DavidsonUndressed/diag_restart_save_one_state.irp.f (100%) rename {src/Davidson => plugins/DavidsonUndressed}/guess_lowest_state.irp.f (100%) rename {src/Davidson => plugins/DavidsonUndressed}/print_H_matrix_restart.irp.f (100%) rename {src/Davidson => plugins/DavidsonUndressed}/print_energy.irp.f (100%) delete mode 100644 plugins/MRCC_Utils/davidson.irp.f delete mode 100644 plugins/MRCC_Utils/multi_state.irp.f create mode 100644 plugins/UndressedMethod/NEEDED_CHILDREN_MODULES create mode 100644 plugins/UndressedMethod/README.rst create mode 100644 plugins/UndressedMethod/null_dressing_vector.irp.f diff --git a/ocaml/Input_determinants_by_hand.ml b/ocaml/Input_determinants_by_hand.ml index 90174e18..ecc68e70 100644 --- a/ocaml/Input_determinants_by_hand.ml +++ b/ocaml/Input_determinants_by_hand.ml @@ -93,8 +93,16 @@ end = struct ;; let write_n_states n = - States_number.to_int n - |> Ezfio.set_determinants_n_states + let n_states = + States_number.to_int n + in + Ezfio.set_determinants_n_states n_states; + let data = + Array.create n_states 1. + |> Array.to_list + in + Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data + |> Ezfio.set_determinants_state_average_weight ;; let write_state_average_weight data = diff --git a/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES b/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES index ae599426..91dd3eff 100644 --- a/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES +++ b/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES @@ -1,2 +1,2 @@ -Generators_CAS Perturbation Selectors_CASSD ZMQ +Generators_CAS Perturbation Selectors_CASSD ZMQ DavidsonUndressed diff --git a/plugins/CID/NEEDED_CHILDREN_MODULES b/plugins/CID/NEEDED_CHILDREN_MODULES index 1632a44d..3272abe5 100644 --- a/plugins/CID/NEEDED_CHILDREN_MODULES +++ b/plugins/CID/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Selectors_full SingleRefMethod Davidson +Selectors_full SingleRefMethod DavidsonUndressed diff --git a/plugins/CID_selected/NEEDED_CHILDREN_MODULES b/plugins/CID_selected/NEEDED_CHILDREN_MODULES index 1e0c52c2..ea9febd6 100644 --- a/plugins/CID_selected/NEEDED_CHILDREN_MODULES +++ b/plugins/CID_selected/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation CID +Perturbation CID DavidsonUndressed diff --git a/plugins/CIS/NEEDED_CHILDREN_MODULES b/plugins/CIS/NEEDED_CHILDREN_MODULES index 1632a44d..3272abe5 100644 --- a/plugins/CIS/NEEDED_CHILDREN_MODULES +++ b/plugins/CIS/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Selectors_full SingleRefMethod Davidson +Selectors_full SingleRefMethod DavidsonUndressed diff --git a/plugins/CISD/NEEDED_CHILDREN_MODULES b/plugins/CISD/NEEDED_CHILDREN_MODULES index 1632a44d..3272abe5 100644 --- a/plugins/CISD/NEEDED_CHILDREN_MODULES +++ b/plugins/CISD/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Selectors_full SingleRefMethod Davidson +Selectors_full SingleRefMethod DavidsonUndressed diff --git a/plugins/Casino/NEEDED_CHILDREN_MODULES b/plugins/Casino/NEEDED_CHILDREN_MODULES index 34de8ddb..2a87d1c1 100644 --- a/plugins/Casino/NEEDED_CHILDREN_MODULES +++ b/plugins/Casino/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants Davidson +Determinants DavidsonUndressed diff --git a/plugins/DavidsonDressed/README.rst b/plugins/DavidsonDressed/README.rst new file mode 100644 index 00000000..ce9c78ba --- /dev/null +++ b/plugins/DavidsonDressed/README.rst @@ -0,0 +1,14 @@ +=============== +DavidsonDressed +=============== + +Davidson with single-column dressing + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. diff --git a/src/Davidson/diagonalization_hs2.irp.f b/plugins/DavidsonDressed/diagonalization_hs2_dressed.irp.f similarity index 84% rename from src/Davidson/diagonalization_hs2.irp.f rename to plugins/DavidsonDressed/diagonalization_hs2_dressed.irp.f index 2dfe468e..8a477b5a 100644 --- a/src/Davidson/diagonalization_hs2.irp.f +++ b/plugins/DavidsonDressed/diagonalization_hs2_dressed.irp.f @@ -1,4 +1,17 @@ -subroutine davidson_diag_hs2(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_diag,Nint,iunit) +BEGIN_PROVIDER [ integer, dressed_column_idx, (N_states) ] + implicit none + BEGIN_DOC + ! Index of the dressed columns + END_DOC + integer :: i + double precision :: tmp + integer, external :: idamax + do i=1,N_states + dressed_column_idx(i) = idamax(size(psi_coef,1), psi_coef(1,i), 1) + enddo +END_PROVIDER + +subroutine davidson_diag_hs2(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_diag,Nint,dressing_state) use bitmasks implicit none BEGIN_DOC @@ -15,41 +28,45 @@ subroutine davidson_diag_hs2(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_d ! ! N_st : Number of eigenstates ! - ! iunit : Unit number for the I/O - ! ! Initial guess vectors are not necessarily orthonormal END_DOC - integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, iunit + integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) double precision, intent(inout) :: u_in(dim_in,N_st_diag) double precision, intent(out) :: energies(N_st_diag), s2_out(N_st_diag) - double precision, allocatable :: H_jj(:) + integer, intent(in) :: dressing_state + double precision, allocatable :: H_jj(:), S2_jj(:) - double precision :: diag_H_mat_elem, diag_S_mat_elem + double precision, external :: diag_H_mat_elem, diag_S_mat_elem integer :: i ASSERT (N_st > 0) ASSERT (sze > 0) ASSERT (Nint > 0) ASSERT (Nint == N_int) PROVIDE mo_bielec_integrals_in_map - allocate(H_jj(sze) ) + allocate(H_jj(sze),S2_jj(sze)) + H_jj(1) = diag_h_mat_elem(dets_in(1,1,1),Nint) !$OMP PARALLEL DEFAULT(NONE) & !$OMP SHARED(sze,H_jj, dets_in,Nint) & !$OMP PRIVATE(i) !$OMP DO SCHEDULE(static) - do i=1,sze + do i=2,sze H_jj(i) = diag_H_mat_elem(dets_in(1,1,i),Nint) enddo !$OMP END DO !$OMP END PARALLEL - call davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_out,energies,dim_in,sze,N_st,N_st_diag,Nint,iunit) - deallocate (H_jj) + if (dressing_state > 0) then + H_jj(dressed_column_idx(dressing_state)) += dressing_column_h(dressed_column_idx(dressing_state),dressing_state) + endif + + call davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_out,energies,dim_in,sze,N_st,N_st_diag,Nint,dressing_state) + deallocate (H_jj,S2_jj) end -subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_st,N_st_diag,Nint,iunit) +subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_st,N_st_diag,Nint,dressing_state) use bitmasks implicit none BEGIN_DOC @@ -72,15 +89,13 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ ! ! N_st_diag : Number of states in which H is diagonalized. Assumed > sze ! - ! iunit : Unit for the I/O - ! ! Initial guess vectors are not necessarily orthonormal END_DOC integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) double precision, intent(in) :: H_jj(sze) + integer, intent(in) :: dressing_state double precision, intent(inout) :: s2_out(N_st_diag) - integer, intent(in) :: iunit double precision, intent(inout) :: u_in(dim_in,N_st_diag) double precision, intent(out) :: energies(N_st_diag) @@ -88,7 +103,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ integer :: i,j,k,l,m logical :: converged - double precision :: u_dot_v, u_dot_u + double precision, external :: u_dot_v, u_dot_u integer :: k_pairs, kl @@ -101,7 +116,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ character*(16384) :: write_buffer double precision :: to_print(3,N_st) double precision :: cpu, wall - integer :: shift, shift2, itermax + integer :: shift, shift2, itermax, istate double precision :: r1, r2 logical :: state_ok(N_st_diag*davidson_sze_max) include 'constants.include.F' @@ -117,35 +132,35 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ PROVIDE nuclear_repulsion expected_s2 psi_bilinear_matrix_order psi_bilinear_matrix_order_reverse - call write_time(iunit) + call write_time(6) call wall_time(wall) call cpu_time(cpu) - write(iunit,'(A)') '' - write(iunit,'(A)') 'Davidson Diagonalization' - write(iunit,'(A)') '------------------------' - write(iunit,'(A)') '' - call write_int(iunit,N_st,'Number of states') - call write_int(iunit,N_st_diag,'Number of states in diagonalization') - call write_int(iunit,sze,'Number of determinants') + write(6,'(A)') '' + write(6,'(A)') 'Davidson Diagonalization' + write(6,'(A)') '------------------------' + write(6,'(A)') '' + call write_int(6,N_st,'Number of states') + call write_int(6,N_st_diag,'Number of states in diagonalization') + call write_int(6,sze,'Number of determinants') r1 = 8.d0*(3.d0*dble(sze*N_st_diag*itermax+5.d0*(N_st_diag*itermax)**2 & + 4.d0*(N_st_diag*itermax)+nproc*(4.d0*N_det_alpha_unique+2.d0*N_st_diag*sze)))/(1024.d0**3) - call write_double(iunit, r1, 'Memory(Gb)') - write(iunit,'(A)') '' + call write_double(6, r1, 'Memory(Gb)') + write(6,'(A)') '' write_buffer = '=====' do i=1,N_st write_buffer = trim(write_buffer)//' ================ =========== ===========' enddo - write(iunit,'(A)') write_buffer(1:6+41*N_states) + write(6,'(A)') write_buffer(1:6+41*N_states) write_buffer = 'Iter' do i=1,N_st write_buffer = trim(write_buffer)//' Energy S^2 Residual ' enddo - write(iunit,'(A)') write_buffer(1:6+41*N_states) + write(6,'(A)') write_buffer(1:6+41*N_states) write_buffer = '=====' do i=1,N_st write_buffer = trim(write_buffer)//' ================ =========== ===========' enddo - write(iunit,'(A)') write_buffer(1:6+41*N_states) + write(6,'(A)') write_buffer(1:6+41*N_states) allocate( & @@ -225,7 +240,21 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ call H_S2_u_0_nstates_openmp(W(1,shift+1),S(1,shift+1),U(1,shift+1),N_st_diag,sze) endif - + if (dressing_state > 0) then + + do istate=1,N_st_diag + l = dressed_column_idx(dressing_state) + do i=1,sze + W(i,shift+istate) += dressing_column_h(i,dressing_state) * U(l,shift+istate) + S(i,shift+istate) += dressing_column_s(i,dressing_state) * U(l,shift+istate) + W(l,shift+istate) += dressing_column_h(i,dressing_state) * U(i,shift+istate) + S(l,shift+istate) += dressing_column_s(i,dressing_state) * U(i,shift+istate) + enddo + W(l,shift+istate) -= dressing_column_h(l,dressing_state) * U(l,shift+istate) + S(l,shift+istate) -= dressing_column_s(l,dressing_state) * U(l,shift+istate) + enddo + endif + ! Compute h_kl = = ! ------------------------------------------- @@ -399,7 +428,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ endif enddo - write(iunit,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter, to_print(1:3,1:N_st) + write(6,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter, to_print(1:3,1:N_st) call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged) do k=1,N_st if (residual_norm(k) > 1.e8) then @@ -429,9 +458,9 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ do i=1,N_st write_buffer = trim(write_buffer)//' ================ =========== ===========' enddo - write(iunit,'(A)') trim(write_buffer) - write(iunit,'(A)') '' - call write_time(iunit) + write(6,'(A)') trim(write_buffer) + write(6,'(A)') '' + call write_time(6) deallocate ( & W, residual_norm, & @@ -443,6 +472,12 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ ) end + + + + + + subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze) use bitmasks implicit none diff --git a/plugins/DavidsonUndressed/NEEDED_CHILDREN_MODULES b/plugins/DavidsonUndressed/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..25180044 --- /dev/null +++ b/plugins/DavidsonUndressed/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ +Davidson UndressedMethod diff --git a/plugins/DavidsonUndressed/README.rst b/plugins/DavidsonUndressed/README.rst new file mode 100644 index 00000000..e11d0703 --- /dev/null +++ b/plugins/DavidsonUndressed/README.rst @@ -0,0 +1,14 @@ +================= +DavidsonUndressed +================= + +Module for main files with undressed Davidson + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. diff --git a/src/Davidson/davidson_slave.irp.f b/plugins/DavidsonUndressed/davidson_slave.irp.f similarity index 100% rename from src/Davidson/davidson_slave.irp.f rename to plugins/DavidsonUndressed/davidson_slave.irp.f diff --git a/src/Davidson/diagonalize_restart_and_save_all_states.irp.f b/plugins/DavidsonUndressed/diag_restart_save_all_states.irp.f similarity index 100% rename from src/Davidson/diagonalize_restart_and_save_all_states.irp.f rename to plugins/DavidsonUndressed/diag_restart_save_all_states.irp.f diff --git a/src/Davidson/diagonalize_restart_and_save_lowest_state.irp.f b/plugins/DavidsonUndressed/diag_restart_save_lowest_state.irp.f similarity index 100% rename from src/Davidson/diagonalize_restart_and_save_lowest_state.irp.f rename to plugins/DavidsonUndressed/diag_restart_save_lowest_state.irp.f diff --git a/src/Davidson/diagonalize_restart_and_save_one_state.irp.f b/plugins/DavidsonUndressed/diag_restart_save_one_state.irp.f similarity index 100% rename from src/Davidson/diagonalize_restart_and_save_one_state.irp.f rename to plugins/DavidsonUndressed/diag_restart_save_one_state.irp.f diff --git a/src/Davidson/guess_lowest_state.irp.f b/plugins/DavidsonUndressed/guess_lowest_state.irp.f similarity index 100% rename from src/Davidson/guess_lowest_state.irp.f rename to plugins/DavidsonUndressed/guess_lowest_state.irp.f diff --git a/src/Davidson/print_H_matrix_restart.irp.f b/plugins/DavidsonUndressed/print_H_matrix_restart.irp.f similarity index 100% rename from src/Davidson/print_H_matrix_restart.irp.f rename to plugins/DavidsonUndressed/print_H_matrix_restart.irp.f diff --git a/src/Davidson/print_energy.irp.f b/plugins/DavidsonUndressed/print_energy.irp.f similarity index 100% rename from src/Davidson/print_energy.irp.f rename to plugins/DavidsonUndressed/print_energy.irp.f diff --git a/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES b/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES index 6736cc4e..cc81a88f 100644 --- a/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES +++ b/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full Generators_full ZMQ FourIdx MPI +Perturbation Selectors_full Generators_full ZMQ FourIdx MPI DavidsonUndressed diff --git a/plugins/MRCC_Utils/H_apply.irp.f b/plugins/MRCC_Utils/H_apply.irp.f index d8dfb62d..7fedd1a8 100644 --- a/plugins/MRCC_Utils/H_apply.irp.f +++ b/plugins/MRCC_Utils/H_apply.irp.f @@ -3,19 +3,17 @@ BEGIN_SHELL [ /usr/bin/env python ] from generate_h_apply import * s = H_apply("mrcc") -s.data["parameters"] = ", delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref" +s.data["parameters"] = ", delta_ij_, Nstates, Ndet_non_ref, Ndet_ref" s.data["declarations"] += """ integer, intent(in) :: Nstates, Ndet_ref, Ndet_non_ref double precision, intent(in) :: delta_ij_(Nstates, Ndet_non_ref, Ndet_ref) - double precision, intent(in) :: delta_ii_(Nstates, Ndet_ref) """ -s.data["keys_work"] = "call mrcc_dress(delta_ij_,delta_ii_,Nstates,Ndet_non_ref,Ndet_ref,i_generator,key_idx,keys_out,N_int,iproc,key_mask)" -s.data["params_post"] += ", delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref" -s.data["params_main"] += "delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref" +s.data["keys_work"] = "call mrcc_dress(delta_ij_,Nstates,Ndet_non_ref,Ndet_ref,i_generator,key_idx,keys_out,N_int,iproc,key_mask)" +s.data["params_post"] += ", delta_ij_, Nstates, Ndet_non_ref, Ndet_ref" +s.data["params_main"] += "delta_ij_, Nstates, Ndet_non_ref, Ndet_ref" s.data["decls_main"] += """ integer, intent(in) :: Ndet_ref, Ndet_non_ref, Nstates double precision, intent(in) :: delta_ij_(Nstates,Ndet_non_ref,Ndet_ref) - double precision, intent(in) :: delta_ii_(Nstates,Ndet_ref) """ s.data["finalization"] = "" s.data["copy_buffer"] = "" diff --git a/plugins/MRCC_Utils/davidson.irp.f b/plugins/MRCC_Utils/davidson.irp.f deleted file mode 100644 index 14b8d816..00000000 --- a/plugins/MRCC_Utils/davidson.irp.f +++ /dev/null @@ -1,1128 +0,0 @@ -subroutine davidson_diag_mrcc(dets_in,u_in,energies,dim_in,sze,N_st,N_st_diag,Nint,iunit,istate) - use bitmasks - implicit none - BEGIN_DOC - ! Davidson diagonalization. - ! - ! dets_in : bitmasks corresponding to determinants - ! - ! u_in : guess coefficients on the various states. Overwritten - ! on exit - ! - ! dim_in : leftmost dimension of u_in - ! - ! sze : Number of determinants - ! - ! N_st : Number of eigenstates - ! - ! iunit : Unit number for the I/O - ! - ! Initial guess vectors are not necessarily orthonormal - END_DOC - integer, intent(in) :: dim_in, sze, N_st, Nint, iunit, istate, N_st_diag - integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) - double precision, intent(inout) :: u_in(dim_in,N_st_diag) - double precision, intent(out) :: energies(N_st_diag) - double precision, allocatable :: H_jj(:) - - double precision :: diag_h_mat_elem - integer :: i - ASSERT (N_st > 0) - ASSERT (N_st_diag >= N_st) - ASSERT (sze > 0) - ASSERT (Nint > 0) - ASSERT (Nint == N_int) - PROVIDE mo_bielec_integrals_in_map - allocate(H_jj(sze)) - - H_jj(1) = diag_h_mat_elem(dets_in(1,1,1),Nint) - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP SHARED(sze,H_jj,N_det_ref,dets_in,Nint,istate,delta_ii,idx_ref) & - !$OMP PRIVATE(i) - !$OMP DO - do i=2,sze - H_jj(i) = diag_h_mat_elem(dets_in(1,1,i),Nint) - enddo - !$OMP END DO - !$OMP END PARALLEL - - do i=1,N_det_ref - H_jj(idx_ref(i)) += delta_ii(istate,i) - enddo - call davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag,Nint,iunit,istate) - deallocate (H_jj) -end - -subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag,Nint,iunit,istate) - use bitmasks - implicit none - BEGIN_DOC - ! Davidson diagonalization with specific diagonal elements of the H matrix - ! - ! H_jj : specific diagonal H matrix elements to diagonalize de Davidson - ! - ! dets_in : bitmasks corresponding to determinants - ! - ! u_in : guess coefficients on the various states. Overwritten - ! on exit - ! - ! dim_in : leftmost dimension of u_in - ! - ! sze : Number of determinants - ! - ! N_st : Number of eigenstates - ! - ! N_st_diag : Number of states in which H is diagonalized - ! - ! iunit : Unit for the I/O - ! - ! Initial guess vectors are not necessarily orthonormal - END_DOC - integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, istate - integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) - double precision, intent(in) :: H_jj(sze) - integer, intent(in) :: iunit - double precision, intent(inout) :: u_in(dim_in,N_st_diag) - double precision, intent(out) :: energies(N_st_diag) - - integer :: iter - integer :: i,j,k,l,m - logical :: converged - - double precision, allocatable :: overlap(:,:) - double precision :: u_dot_v, u_dot_u - - integer :: k_pairs, kl - - integer :: iter2 - double precision, allocatable :: W(:,:,:), U(:,:,:), R(:,:) - double precision, allocatable :: y(:,:,:,:), h(:,:,:,:), lambda(:) - double precision, allocatable :: c(:), H_small(:,:) - double precision :: diag_h_mat_elem - double precision, allocatable :: residual_norm(:) - character*(16384) :: write_buffer - double precision :: to_print(2,N_st) - double precision :: cpu, wall - include 'constants.include.F' - - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, R, y, h, lambda - - PROVIDE nuclear_repulsion - - call write_time(iunit) - call wall_time(wall) - call cpu_time(cpu) - write(iunit,'(A)') '' - write(iunit,'(A)') 'Davidson Diagonalization' - write(iunit,'(A)') '------------------------' - write(iunit,'(A)') '' - call write_int(iunit,N_st,'Number of states') - call write_int(iunit,N_st_diag,'Number of states in diagonalization') - call write_int(iunit,sze,'Number of determinants') - call write_int(iunit,istate,'Using dressing for state ') - write(iunit,'(A)') '' - write_buffer = '===== ' - do i=1,N_st - write_buffer = trim(write_buffer)//' ================ ================' - enddo - write(iunit,'(A)') trim(write_buffer) - write_buffer = ' Iter' - do i=1,N_st - write_buffer = trim(write_buffer)//' Energy Residual' - enddo - write(iunit,'(A)') trim(write_buffer) - write_buffer = '===== ' - do i=1,N_st - write_buffer = trim(write_buffer)//' ================ ================' - enddo - write(iunit,'(A)') trim(write_buffer) - - allocate( & - W(sze,N_st_diag,davidson_sze_max), & - U(sze,N_st_diag,davidson_sze_max), & - R(sze,N_st_diag), & - h(N_st_diag,davidson_sze_max,N_st_diag,davidson_sze_max), & - y(N_st_diag,davidson_sze_max,N_st_diag,davidson_sze_max), & - residual_norm(N_st_diag), & - overlap(N_st_diag,N_st_diag), & - c(N_st_diag*davidson_sze_max), & - H_small(N_st_diag,N_st_diag), & - lambda(N_st_diag*davidson_sze_max)) - - ASSERT (N_st > 0) - ASSERT (N_st_diag >= N_st) - ASSERT (sze > 0) - ASSERT (Nint > 0) - ASSERT (Nint == N_int) - - ! Initialization - ! ============== - - - do k=1,N_st_diag - - if (k > N_st) then - do i=1,sze - double precision :: r1, r2 - call random_number(r1) - call random_number(r2) - u_in(i,k) = dsqrt(-2.d0*dlog(r1))*dcos(dtwo_pi*r2) - enddo - endif - - ! Gram-Schmidt - ! ------------ - call dgemv('T',sze,k-1,1.d0,u_in,size(u_in,1), & - u_in(1,k),1,0.d0,c,1) - call dgemv('N',sze,k-1,-1.d0,u_in,size(u_in,1), & - c,1,1.d0,u_in(1,k),1) - call normalize(u_in(1,k),sze) - enddo - - - - converged = .False. - do while (.not.converged) - - do k=1,N_st_diag - do i=1,sze - U(i,k,1) = u_in(i,k) - enddo - enddo - - do iter=1,davidson_sze_max-1 - - ! Compute |W_k> = \sum_i |i> - ! ----------------------------------------- - - call H_u_0_mrcc_nstates(W(1,1,iter),U(1,1,iter),H_jj,sze,dets_in,Nint,istate,N_st_diag,sze) - - - ! Compute h_kl = = - ! ------------------------------------------- - - - call dgemm('T','N', N_st_diag*iter, N_st_diag, sze, & - 1.d0, U, size(U,1), W(1,1,iter), size(W,1), & - 0.d0, h(1,1,1,iter), size(h,1)*size(h,2)) - - ! Diagonalize h - ! ------------- - call lapack_diag(lambda,y,h,N_st_diag*davidson_sze_max,N_st_diag*iter) - - ! Express eigenvectors of h in the determinant basis - ! -------------------------------------------------- - - do k=1,N_st_diag - do i=1,sze - U(i,k,iter+1) = 0.d0 - W(i,k,iter+1) = 0.d0 - enddo - enddo -! - call dgemm('N','N', sze, N_st_diag, N_st_diag*iter, & - 1.d0, U, size(U,1), y, size(y,1)*size(y,2), 0.d0, U(1,1,iter+1), size(U,1)) - call dgemm('N','N',sze,N_st_diag,N_st_diag*iter, & - 1.d0, W, size(W,1), y, size(y,1)*size(y,2), 0.d0, W(1,1,iter+1), size(W,1)) - - - ! Compute residual vector - ! ----------------------- - - do k=1,N_st_diag - do i=1,sze - R(i,k) = lambda(k) * U(i,k,iter+1) - W(i,k,iter+1) - enddo - if (k <= N_st) then - residual_norm(k) = u_dot_u(R(1,k),sze) - to_print(1,k) = lambda(k) + nuclear_repulsion - to_print(2,k) = residual_norm(k) - endif - enddo - - write(iunit,'(X,I3,X,100(X,F16.10,X,E16.6))') iter, to_print(:,1:N_st) - call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged) - if (converged) then - exit - endif - - ! Davidson step - ! ------------- - - do k=1,N_st_diag - do i=1,sze - U(i,k,iter+1) = -1.d0/max(H_jj(i) - lambda(k),1.d-2) * R(i,k) - enddo - enddo - - ! Gram-Schmidt - ! ------------ - - do k=1,N_st_diag - - call dgemv('T',sze,N_st_diag*iter,1.d0,U,size(U,1), & - U(1,k,iter+1),1,0.d0,c,1) - call dgemv('N',sze,N_st_diag*iter,-1.d0,U,size(U,1), & - c,1,1.d0,U(1,k,iter+1),1) - - call dgemv('T',sze,k-1,1.d0,U(1,1,iter+1),size(U,1), & - U(1,k,iter+1),1,0.d0,c,1) - call dgemv('N',sze,k-1,-1.d0,U(1,1,iter+1),size(U,1), & - c,1,1.d0,U(1,k,iter+1),1) - - call normalize( U(1,k,iter+1), sze ) - enddo - - enddo - - if (.not.converged) then - iter = davidson_sze_max-1 - endif - - ! Re-contract to u_in - ! ----------- - - do k=1,N_st_diag - do i=1,sze - u_in(i,k) = 0.d0 - enddo - enddo - - call dgemm('N','N', sze, N_st_diag, N_st_diag*iter, 1.d0, & - U, size(U,1), y, N_st_diag*davidson_sze_max, & - 0.d0, u_in, size(u_in,1)) - - enddo - - do k=1,N_st_diag - energies(k) = lambda(k) - enddo - write_buffer = '===== ' - do i=1,N_st - write_buffer = trim(write_buffer)//' ================ ================' - enddo - write(iunit,'(A)') trim(write_buffer) - write(iunit,'(A)') '' - call write_time(iunit) - - deallocate ( & - W, residual_norm, & - U, overlap, & - R, c, & - h, & - y, & - lambda & - ) -end - - -subroutine u_0_H_u_0_mrcc_nstates(e_0,u_0,n,keys_tmp,Nint,istate,N_st,sze) - use bitmasks - implicit none - BEGIN_DOC - ! Computes e_0 = / - ! - ! n : number of determinants - ! - END_DOC - integer, intent(in) :: n,Nint,N_st,sze - double precision, intent(out) :: e_0(N_st) - double precision, intent(in) :: u_0(sze,N_st) - integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) - integer,intent(in) :: istate - - double precision, allocatable :: v_0(:,:), H_jj(:) - double precision :: u_dot_u,u_dot_v,diag_H_mat_elem - integer :: i,j - allocate(H_jj(n), v_0(sze,N_st)) - do i = 1, n - H_jj(i) = diag_H_mat_elem(keys_tmp(1,1,i),Nint) - enddo - - do i=1,N_det_ref - H_jj(idx_ref(i)) += delta_ii(istate,i) - enddo - - call H_u_0_mrcc_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,istate,N_st,sze) - do i=1,N_st - e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/u_dot_u(u_0(1,i),n) - enddo - deallocate(H_jj, v_0) -end - - -subroutine H_u_0_mrcc_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,istate_in,N_st,sze) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_0 = H|u_0> - ! - ! n : number of determinants - ! - ! H_jj : array of - END_DOC - integer, intent(in) :: n,Nint,istate_in,N_st,sze - double precision, intent(out) :: v_0(sze,N_st) - double precision, intent(in) :: u_0(sze,N_st) - double precision, intent(in) :: H_jj(n) - integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) - double precision :: hij - double precision, allocatable :: vt(:,:) - integer :: i,j,k,l, jj,ii - integer :: i0, j0 - integer(bit_kind) :: sorted_i(Nint) - - - integer,allocatable :: shortcut(:,:), sort_idx(:,:) - integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:) - - - integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, pass, istate - - - ASSERT (Nint > 0) - ASSERT (Nint == N_int) - ASSERT (n>0) - PROVIDE ref_bitmask_energy - allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2)) - v_0 = 0.d0 - - call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint) - call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint) - - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP PRIVATE(i,hij,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)& - !$OMP SHARED(n,H_jj,u_0,keys_tmp,Nint,v_0,sorted,shortcut,sort_idx,version,N_st,sze,& - !$OMP istate_in,delta_ij,N_det_ref,N_det_non_ref,idx_ref,idx_non_ref) - allocate(vt(sze,N_st)) - Vt = 0.d0 - - !$OMP DO SCHEDULE(static,1) - do sh=1,shortcut(0,1) - do sh2=sh,shortcut(0,1) - exa = 0 - do ni=1,Nint - exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1))) - end do - if(exa > 2) then - cycle - end if - - do i=shortcut(sh,1),shortcut(sh+1,1)-1 - org_i = sort_idx(i,1) - if(sh==sh2) then - endi = i-1 - else - endi = shortcut(sh2+1,1)-1 - end if - do ni=1,Nint - sorted_i(ni) = sorted(ni,i,1) - enddo - - do j=shortcut(sh2,1),endi - org_j = sort_idx(j,1) - ext = exa - do ni=1,Nint - ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) - end do - if(ext <= 4) then - call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) - do istate=1,N_st - vt (org_i,istate) = vt (org_i,istate) + hij*u_0(org_j,istate) - vt (org_j,istate) = vt (org_j,istate) + hij*u_0(org_i,istate) - enddo - endif - enddo - enddo - enddo - enddo - !$OMP END DO - - !$OMP DO SCHEDULE(static,1) - do sh=1,shortcut(0,2) - do i=shortcut(sh,2),shortcut(sh+1,2)-1 - org_i = sort_idx(i,2) - do j=shortcut(sh,2),i-1 - org_j = sort_idx(j,2) - ext = 0 - do ni=1,Nint - ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2))) - end do - if(ext == 4) then - call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) - do istate=1,N_st - vt (org_i,istate) = vt (org_i,istate) + hij*u_0(org_j,istate) - vt (org_j,istate) = vt (org_j,istate) + hij*u_0(org_i,istate) - enddo - end if - end do - end do - enddo - !$OMP END DO - - !$OMP DO - do ii=1,n_det_ref - i = idx_ref(ii) - do jj = 1, n_det_non_ref - j = idx_non_ref(jj) - do istate=1,N_st - vt (i,istate) = vt (i,istate) + delta_ij(istate_in,jj,ii)*u_0(j,istate) - vt (j,istate) = vt (j,istate) + delta_ij(istate_in,jj,ii)*u_0(i,istate) - enddo - enddo - enddo - !$OMP END DO - - do istate=1,N_st - do i=n,1,-1 - !$OMP ATOMIC - v_0(i,istate) = v_0(i,istate) + vt(i,istate) - enddo - enddo - - deallocate(vt) - !$OMP END PARALLEL - - do istate=1,N_st - do i=1,n - v_0(i,istate) += H_jj(i) * u_0(i,istate) - enddo - enddo - deallocate (shortcut, sort_idx, sorted, version) - -end - - -subroutine davidson_diag_mrcc_hs2(dets_in,u_in,dim_in,energies,sze,N_st,N_st_diag,Nint,iunit,istate) - use bitmasks - implicit none - BEGIN_DOC - ! Davidson diagonalization. - ! - ! dets_in : bitmasks corresponding to determinants - ! - ! u_in : guess coefficients on the various states. Overwritten - ! on exit - ! - ! dim_in : leftmost dimension of u_in - ! - ! sze : Number of determinants - ! - ! N_st : Number of eigenstates - ! - ! iunit : Unit number for the I/O - ! - ! Initial guess vectors are not necessarily orthonormal - END_DOC - integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, iunit, istate - integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) - double precision, intent(inout) :: u_in(dim_in,N_st_diag) - double precision, intent(out) :: energies(N_st_diag) - double precision, allocatable :: H_jj(:), S2_jj(:) - - double precision :: diag_h_mat_elem - integer :: i - ASSERT (N_st > 0) - ASSERT (sze > 0) - ASSERT (Nint > 0) - ASSERT (Nint == N_int) - PROVIDE mo_bielec_integrals_in_map - allocate(H_jj(sze), S2_jj(sze)) - - H_jj(1) = diag_h_mat_elem(dets_in(1,1,1),Nint) - call get_s2(dets_in(1,1,1),dets_in(1,1,1),Nint,S2_jj(1)) - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP SHARED(sze,H_jj,S2_jj, dets_in,Nint,N_det_ref,delta_ii, & - !$OMP idx_ref, istate) & - !$OMP PRIVATE(i) - !$OMP DO - do i=2,sze - H_jj(i) = diag_h_mat_elem(dets_in(1,1,i),Nint) - call get_s2(dets_in(1,1,i),dets_in(1,1,i),Nint,S2_jj(i)) - enddo - !$OMP END DO - !$OMP END PARALLEL - - do i=1,N_det_ref - H_jj(idx_ref(i)) += delta_ii(istate,i) - enddo - - call davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_st,N_st_diag,Nint,iunit,istate) - deallocate (H_jj,S2_jj) -end - - -subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_st,N_st_diag,Nint,iunit,istate ) - use bitmasks - implicit none - BEGIN_DOC - ! Davidson diagonalization with specific diagonal elements of the H matrix - ! - ! H_jj : specific diagonal H matrix elements to diagonalize de Davidson - ! - ! S2_jj : specific diagonal S^2 matrix elements - ! - ! dets_in : bitmasks corresponding to determinants - ! - ! u_in : guess coefficients on the various states. Overwritten - ! on exit - ! - ! dim_in : leftmost dimension of u_in - ! - ! sze : Number of determinants - ! - ! N_st : Number of eigenstates - ! - ! N_st_diag : Number of states in which H is diagonalized. Assumed > sze - ! - ! iunit : Unit for the I/O - ! - ! Initial guess vectors are not necessarily orthonormal - END_DOC - integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint, istate - integer(bit_kind), intent(in) :: dets_in(Nint,2,sze) - double precision, intent(in) :: H_jj(sze), S2_jj(sze) - integer, intent(in) :: iunit - double precision, intent(inout) :: u_in(dim_in,N_st_diag) - double precision, intent(out) :: energies(N_st_diag) - - integer :: iter - integer :: i,j,k,l,m - logical :: converged - - double precision :: u_dot_v, u_dot_u - - integer :: k_pairs, kl - - integer :: iter2 - double precision, allocatable :: W(:,:), U(:,:), S(:,:), overlap(:,:) - double precision, allocatable :: y(:,:), h(:,:), lambda(:), s2(:) - double precision, allocatable :: c(:), s_(:,:), s_tmp(:,:) - double precision :: diag_h_mat_elem - double precision, allocatable :: residual_norm(:) - character*(16384) :: write_buffer - double precision :: to_print(3,N_st) - double precision :: cpu, wall - integer :: shift, shift2, itermax - include 'constants.include.F' - - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, S, y, h, lambda - if (N_st_diag*3 > sze) then - print *, 'error in Davidson :' - print *, 'Increase n_det_max_jacobi to ', N_st_diag*3 - stop -1 - endif - - PROVIDE nuclear_repulsion - - call write_time(iunit) - call wall_time(wall) - call cpu_time(cpu) - write(iunit,'(A)') '' - write(iunit,'(A)') 'Davidson Diagonalization' - write(iunit,'(A)') '------------------------' - write(iunit,'(A)') '' - call write_int(iunit,N_st,'Number of states') - call write_int(iunit,N_st_diag,'Number of states in diagonalization') - call write_int(iunit,sze,'Number of determinants') - call write_int(iunit,istate,'Using dressing for state ') - - write(iunit,'(A)') '' - write_buffer = '===== ' - do i=1,N_st - write_buffer = trim(write_buffer)//' ================ =========== ===========' - enddo - write(iunit,'(A)') trim(write_buffer) - write_buffer = ' Iter' - do i=1,N_st - write_buffer = trim(write_buffer)//' Energy S^2 Residual ' - enddo - write(iunit,'(A)') trim(write_buffer) - write_buffer = '===== ' - do i=1,N_st - write_buffer = trim(write_buffer)//' ================ =========== ===========' - enddo - write(iunit,'(A)') trim(write_buffer) - - itermax = min(davidson_sze_max, sze/N_st_diag) - allocate( & - W(sze,N_st_diag*itermax), & - U(sze,N_st_diag*itermax), & - S(sze,N_st_diag*itermax), & - h(N_st_diag*itermax,N_st_diag*itermax), & - y(N_st_diag*itermax,N_st_diag*itermax), & - s_(N_st_diag*itermax,N_st_diag*itermax), & - s_tmp(N_st_diag*itermax,N_st_diag*itermax), & - residual_norm(N_st_diag), & - c(N_st_diag*itermax), & - s2(N_st_diag*itermax), & - overlap(N_st_diag*itermax,N_st_diag*itermax), & - lambda(N_st_diag*itermax)) - - h = 0.d0 - s_ = 0.d0 - s_tmp = 0.d0 - U = 0.d0 - W = 0.d0 - S = 0.d0 - y = 0.d0 - - - ASSERT (N_st > 0) - ASSERT (N_st_diag >= N_st) - ASSERT (sze > 0) - ASSERT (Nint > 0) - ASSERT (Nint == N_int) - - ! Davidson iterations - ! =================== - - converged = .False. - - double precision :: r1, r2 - do k=N_st+1,N_st_diag - u_in(k,k) = 10.d0 - do i=1,sze - call random_number(r1) - call random_number(r2) - r1 = dsqrt(-2.d0*dlog(r1)) - r2 = dtwo_pi*r2 - u_in(i,k) = r1*dcos(r2) - enddo - enddo - do k=1,N_st_diag - call normalize(u_in(1,k),sze) - enddo - - - do while (.not.converged) - - do k=1,N_st_diag - do i=1,sze - U(i,k) = u_in(i,k) - enddo - enddo - - do iter=1,davidson_sze_max-1 - - shift = N_st_diag*(iter-1) - shift2 = N_st_diag*iter - - call ortho_qr(U,size(U,1),sze,shift2) - - ! Compute |W_k> = \sum_i |i> - ! ----------------------------------------- - - call H_S2_u_0_mrcc_nstates(W(1,shift+1),S(1,shift+1),U(1,shift+1),H_jj,S2_jj,sze,dets_in,Nint,& - istate,N_st_diag,sze) - - - ! Compute h_kl = = - ! ------------------------------------------- - - - call dgemm('T','N', shift2, shift2, sze, & - 1.d0, U, size(U,1), W, size(W,1), & - 0.d0, h, size(h,1)) - - call dgemm('T','N', shift2, shift2, sze, & - 1.d0, U, size(U,1), S, size(S,1), & - 0.d0, s_, size(s_,1)) - -! ! Diagonalize S^2 -! ! --------------- -! -! call lapack_diag(s2,y,s_,size(s_,1),shift2) -! -! ! Rotate H in the basis of eigenfunctions of s2 -! ! --------------------------------------------- -! -! call dgemm('N','N',shift2,shift2,shift2, & -! 1.d0, h, size(h,1), y, size(y,1), & -! 0.d0, s_tmp, size(s_tmp,1)) -! -! call dgemm('T','N',shift2,shift2,shift2, & -! 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & -! 0.d0, h, size(h,1)) -! -! ! Damp interaction between different spin states -! ! ------------------------------------------------ -! -! do k=1,shift2 -! do l=1,shift2 -! if (dabs(s2(k) - s2(l)) > 1.d0) then -! h(k,l) = h(k,l)*(max(0.d0,1.d0 - dabs(s2(k) - s2(l)))) -! endif -! enddo -! enddo -! -! ! Rotate back H -! ! ------------- -! -! call dgemm('N','T',shift2,shift2,shift2, & -! 1.d0, h, size(h,1), y, size(y,1), & -! 0.d0, s_tmp, size(s_tmp,1)) -! -! call dgemm('N','N',shift2,shift2,shift2, & -! 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & -! 0.d0, h, size(h,1)) - - - ! Diagonalize h - ! ------------- - call lapack_diag(lambda,y,h,size(h,1),shift2) - - ! Compute S2 for each eigenvector - ! ------------------------------- - - call dgemm('N','N',shift2,shift2,shift2, & - 1.d0, s_, size(s_,1), y, size(y,1), & - 0.d0, s_tmp, size(s_tmp,1)) - - call dgemm('T','N',shift2,shift2,shift2, & - 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & - 0.d0, s_, size(s_,1)) - - do k=1,shift2 - s2(k) = s_(k,k) + S_z2_Sz - enddo - - if (s2_eig) then - logical :: state_ok(N_st_diag*davidson_sze_max) - do k=1,shift2 - state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0) - enddo - else - do k=1,size(state_ok) - state_ok(k) = .True. - enddo - endif - - do k=1,shift2 - if (.not. state_ok(k)) then - do l=k+1,shift2 - if (state_ok(l)) then - call dswap(shift2, y(1,k), 1, y(1,l), 1) - call dswap(1, s2(k), 1, s2(l), 1) - call dswap(1, lambda(k), 1, lambda(l), 1) - state_ok(k) = .True. - state_ok(l) = .False. - exit - endif - enddo - endif - enddo - - if (state_following) then - - ! Compute overlap with U_in - ! ------------------------- - - integer :: order(N_st_diag) - double precision :: cmax - overlap = -1.d0 - do k=1,shift2 - do i=1,shift2 - overlap(k,i) = dabs(y(k,i)) - enddo - enddo - do k=1,N_st - cmax = -1.d0 - do i=1,N_st - if (overlap(i,k) > cmax) then - cmax = overlap(i,k) - order(k) = i - endif - enddo - do i=1,shift2 - overlap(order(k),i) = -1.d0 - enddo - enddo - overlap = y - do k=1,N_st - l = order(k) - if (k /= l) then - y(1:shift2,k) = overlap(1:shift2,l) - endif - enddo - do k=1,N_st - overlap(k,1) = lambda(k) - overlap(k,2) = s2(k) - enddo - do k=1,N_st - l = order(k) - if (k /= l) then - lambda(k) = overlap(l,1) - s2(k) = overlap(l,2) - endif - enddo - - endif - - - ! Express eigenvectors of h in the determinant basis - ! -------------------------------------------------- - - call dgemm('N','N', sze, N_st_diag, shift2, & - 1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1)) - call dgemm('N','N', sze, N_st_diag, shift2, & - 1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1)) - call dgemm('N','N', sze, N_st_diag, shift2, & - 1.d0, S, size(S,1), y, size(y,1), 0.d0, S(1,shift2+1), size(S,1)) - - ! Compute residual vector - ! ----------------------- - - do k=1,N_st_diag -! if (state_ok(k)) then - do i=1,sze - U(i,shift2+k) = (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & - * (1.d0 + s2(k) * U(i,shift2+k) - S(i,shift2+k) - S_z2_Sz & - )/max(H_jj(i) - lambda (k),1.d-2) - enddo -! else -! ! Randomize components with bad -! do i=1,sze-2,2 -! call random_number(r1) -! call random_number(r2) -! r1 = dsqrt(-2.d0*dlog(r1)) -! r2 = dtwo_pi*r2 -! U(i,shift2+k) = r1*dcos(r2) -! U(i+1,shift2+k) = r1*dsin(r2) -! enddo -! do i=sze-2+1,sze -! call random_number(r1) -! call random_number(r2) -! r1 = dsqrt(-2.d0*dlog(r1)) -! r2 = dtwo_pi*r2 -! U(i,shift2+k) = r1*dcos(r2) -! enddo -! endif - - if (k <= N_st) then - residual_norm(k) = u_dot_u(U(1,shift2+k),sze) - to_print(1,k) = lambda(k) + nuclear_repulsion - to_print(2,k) = s2(k) - to_print(3,k) = residual_norm(k) - endif - enddo - - write(iunit,'(X,I3,X,100(X,F16.10,X,F11.6,X,E11.3))') iter, to_print(1:3,1:N_st) - call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged) - do k=1,N_st - if (residual_norm(k) > 1.e8) then - print *, '' - stop 'Davidson failed' - endif - enddo - if (converged) then - exit - endif - - enddo - - ! Re-contract to u_in - ! ----------- - - call dgemm('N','N', sze, N_st_diag, shift2, & - 1.d0, U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) - - enddo - - do k=1,N_st_diag - energies(k) = lambda(k) - enddo - - write_buffer = '===== ' - do i=1,N_st - write_buffer = trim(write_buffer)//' ================ =========== ===========' - enddo - write(iunit,'(A)') trim(write_buffer) - write(iunit,'(A)') '' - call write_time(iunit) - - deallocate ( & - W, residual_norm, & - U, overlap, & - c, S, & - h, & - y, s_, s_tmp, & - lambda & - ) -end - - -subroutine H_S2_u_0_mrcc_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,istate_in,N_st,sze) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_0 = H|u_0> and s_0 = S^2 |u_0> - ! - ! n : number of determinants - ! - ! H_jj : array of - ! - ! S2_jj : array of - END_DOC - integer, intent(in) :: N_st,n,Nint, sze, istate_in - double precision, intent(out) :: v_0(sze,N_st), s_0(sze,N_st) - double precision, intent(in) :: u_0(sze,N_st) - double precision, intent(in) :: H_jj(n), S2_jj(n) - integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) - double precision :: hij,s2 - double precision, allocatable :: vt(:,:), ut(:,:), st(:,:) - integer :: i,j,k,l, jj,ii - integer :: i0, j0 - - integer, allocatable :: shortcut(:,:), sort_idx(:,:) - integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:) - integer(bit_kind) :: sorted_i(Nint) - - integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, istate - - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: vt, ut - - ASSERT (Nint > 0) - ASSERT (Nint == N_int) - ASSERT (n>0) - PROVIDE ref_bitmask_energy - - allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2)) - allocate(ut(N_st,n)) - - v_0 = 0.d0 - s_0 = 0.d0 - - do i=1,n - do istate=1,N_st - ut(istate,i) = u_0(i,istate) - enddo - enddo - - call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint) - call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint) - - PROVIDE delta_ij_s2 - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP PRIVATE(i,hij,s2,j,k,jj,vt,st,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)& - !$OMP SHARED(n,keys_tmp,ut,Nint,v_0,s_0,sorted,shortcut,sort_idx,version,N_st, & - !$OMP N_det_ref, idx_ref, N_det_non_ref, idx_non_ref, delta_ij, delta_ij_s2,istate_in) - allocate(vt(N_st,n),st(N_st,n)) - Vt = 0.d0 - St = 0.d0 - - !$OMP DO SCHEDULE(guided) - do sh=1,shortcut(0,1) - do sh2=sh,shortcut(0,1) - exa = 0 - do ni=1,Nint - exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1))) - end do - if(exa > 2) then - cycle - end if - - do i=shortcut(sh,1),shortcut(sh+1,1)-1 - org_i = sort_idx(i,1) - if(sh==sh2) then - endi = i-1 - else - endi = shortcut(sh2+1,1)-1 - end if - do ni=1,Nint - sorted_i(ni) = sorted(ni,i,1) - enddo - - do j=shortcut(sh2,1),endi - org_j = sort_idx(j,1) - ext = exa - do ni=1,Nint - ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) - end do - if(ext <= 4) then - call i_h_j (keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,hij) - call get_s2(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,s2) - do istate=1,n_st - vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,org_j) - vt (istate,org_j) = vt (istate,org_j) + hij*ut(istate,org_i) - st (istate,org_i) = st (istate,org_i) + s2*ut(istate,org_j) - st (istate,org_j) = st (istate,org_j) + s2*ut(istate,org_i) - enddo - endif - enddo - enddo - enddo - enddo - !$OMP END DO - - !$OMP DO SCHEDULE(guided) - do sh=1,shortcut(0,2) - do i=shortcut(sh,2),shortcut(sh+1,2)-1 - org_i = sort_idx(i,2) - do j=shortcut(sh,2),i-1 - org_j = sort_idx(j,2) - ext = 0 - do ni=1,Nint - ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2))) - end do - if(ext == 4) then - call i_h_j (keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,hij) - call get_s2(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,s2) - do istate=1,n_st - vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,org_j) - vt (istate,org_j) = vt (istate,org_j) + hij*ut(istate,org_i) - st (istate,org_i) = st (istate,org_i) + s2*ut(istate,org_j) - st (istate,org_j) = st (istate,org_j) + s2*ut(istate,org_i) - enddo - end if - end do - end do - enddo - !$OMP END DO - -! -------------------------- -! Begin Specific to dressing -! -------------------------- - -!TODO : DRESSING 1 column - - !$OMP DO - do ii=1,n_det_ref - i = idx_ref(ii) - do jj = 1, n_det_non_ref - j = idx_non_ref(jj) - do istate=1,N_st - vt (istate,i) = vt (istate,i) + delta_ij(istate_in,jj,ii)*ut(istate,j) - vt (istate,j) = vt (istate,j) + delta_ij(istate_in,jj,ii)*ut(istate,i) - st (istate,i) = st (istate,i) + delta_ij_s2(istate_in,jj,ii)*ut(istate,j) - st (istate,j) = st (istate,j) + delta_ij_s2(istate_in,jj,ii)*ut(istate,i) - enddo - enddo - enddo - !$OMP END DO - -! ------------------------ -! End Specific to dressing -! ------------------------ - - do istate=1,N_st - do i=n,1,-1 - !$OMP ATOMIC - v_0(i,istate) = v_0(i,istate) + vt(istate,i) - !$OMP ATOMIC - s_0(i,istate) = s_0(i,istate) + st(istate,i) - enddo - enddo - - deallocate(vt,st) - !$OMP END PARALLEL - - do istate=1,N_st - do i=1,n - v_0(i,istate) = v_0(i,istate) + H_jj(i) * u_0(i,istate) - s_0(i,istate) = s_0(i,istate) + s2_jj(i)* u_0(i,istate) - enddo - enddo - deallocate (shortcut, sort_idx, sorted, version, ut) -end - diff --git a/plugins/MRCC_Utils/mrcc_dress.irp.f b/plugins/MRCC_Utils/mrcc_dress.irp.f index 5c2f5efc..41041288 100644 --- a/plugins/MRCC_Utils/mrcc_dress.irp.f +++ b/plugins/MRCC_Utils/mrcc_dress.irp.f @@ -14,14 +14,13 @@ BEGIN_PROVIDER [ integer(omp_lock_kind), psi_ref_lock, (psi_det_size) ] END_PROVIDER -subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_generator,n_selected,det_buffer,Nint,iproc,key_mask) +subroutine mrcc_dress(delta_ij_, Nstates, Ndet_non_ref, Ndet_ref,i_generator,n_selected,det_buffer,Nint,iproc,key_mask) use bitmasks implicit none integer, intent(in) :: i_generator,n_selected, Nint, iproc integer, intent(in) :: Nstates, Ndet_ref, Ndet_non_ref double precision, intent(inout) :: delta_ij_(Nstates,Ndet_non_ref,Ndet_ref) - double precision, intent(inout) :: delta_ii_(Nstates,Ndet_ref) integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) integer :: i,j,k,l,m @@ -265,10 +264,8 @@ subroutine mrcc_dress(delta_ij_, delta_ii_, Nstates, Ndet_non_ref, Ndet_ref,i_ge do l_sd=1,idx_alpha(0) k_sd = idx_alpha(l_sd) delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd) - delta_ii_(i_state,i_I) = delta_ii_(i_state,i_I) - dIa_hla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) enddo else - !delta_ii_(i_state,i_I) = 0.d0 do l_sd=1,idx_alpha(0) k_sd = idx_alpha(l_sd) delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + 0.5d0 * dIa_hla(i_state,k_sd) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 6609790b..ad653c8c 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -139,210 +139,6 @@ BEGIN_PROVIDER [ double precision, hij_mrcc, (N_det_non_ref,N_det_ref) ] END_PROVIDER -BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ] - implicit none - BEGIN_DOC - ! Dressed H with Delta_ij - END_DOC - integer :: i, j,istate,ii,jj - do istate = 1,N_states - do j=1,N_det - do i=1,N_det - h_matrix_dressed(i,j,istate) = h_matrix_all_dets(i,j) - enddo - enddo - do ii = 1, N_det_ref - i =idx_ref(ii) - h_matrix_dressed(i,i,istate) += delta_ii(istate,ii) - do jj = 1, N_det_non_ref - j =idx_non_ref(jj) - h_matrix_dressed(i,j,istate) += delta_ij(istate,jj,ii) - h_matrix_dressed(j,i,istate) += delta_ij(istate,jj,ii) - enddo - enddo - enddo -END_PROVIDER - - - BEGIN_PROVIDER [ double precision, CI_electronic_energy_dressed, (N_states_diag) ] -&BEGIN_PROVIDER [ double precision, CI_eigenvectors_dressed, (N_det,N_states_diag) ] -&BEGIN_PROVIDER [ double precision, CI_eigenvectors_s2_dressed, (N_states_diag) ] - implicit none - BEGIN_DOC - ! Eigenvectors/values of the dressed CI matrix - END_DOC - double precision :: ovrlp,u_dot_v - integer :: i_good_state - integer, allocatable :: index_good_state_array(:) - logical, allocatable :: good_state_array(:) - double precision, allocatable :: s2_values_tmp(:) - integer :: i_other_state - double precision, allocatable :: eigenvectors(:,:), eigenvalues(:) - integer :: i_state - double precision :: e_0 - integer :: i,j,k - double precision, allocatable :: s2_eigvalues(:) - double precision, allocatable :: e_array(:) - integer, allocatable :: iorder(:) - - integer :: mrcc_state - - do j=1,min(N_states,N_det) - do i=1,N_det - CI_eigenvectors_dressed(i,j) = psi_coef(i,j) - enddo - enddo - - if (diag_algorithm == "Davidson") then - - allocate (eigenvectors(size(CI_eigenvectors_dressed,1),size(CI_eigenvectors_dressed,2)),& - eigenvalues(size(CI_electronic_energy_dressed,1))) - do j=1,min(N_states,N_det) - do i=1,N_det - eigenvectors(i,j) = psi_coef(i,j) - enddo - enddo - do mrcc_state=1,N_states - do j=mrcc_state,min(N_states,N_det) - do i=1,N_det - eigenvectors(i,j) = psi_coef(i,j) - enddo - enddo - call davidson_diag_mrcc_HS2(psi_det,eigenvectors, & - size(eigenvectors,1), & - eigenvalues,N_det,N_states,N_states_diag,N_int, & - 6,mrcc_state) - CI_eigenvectors_dressed(1:N_det,mrcc_state) = eigenvectors(1:N_det,mrcc_state) - CI_electronic_energy_dressed(mrcc_state) = eigenvalues(mrcc_state) - enddo - do k=N_states+1,N_states_diag - CI_eigenvectors_dressed(1:N_det,k) = eigenvectors(1:N_det,k) - CI_electronic_energy_dressed(k) = eigenvalues(k) - enddo - call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,& - N_states_diag,size(CI_eigenvectors_dressed,1)) - - deallocate (eigenvectors,eigenvalues) - - else if (diag_algorithm == "Lapack") then - - allocate (eigenvectors(size(H_matrix_dressed,1),N_det)) - allocate (eigenvalues(N_det)) - call lapack_diag(eigenvalues,eigenvectors, & - H_matrix_dressed,size(H_matrix_dressed,1),N_det) - CI_electronic_energy_dressed(:) = 0.d0 - if (s2_eig) then - i_state = 0 - allocate (s2_eigvalues(N_det)) - allocate(index_good_state_array(N_det),good_state_array(N_det)) - good_state_array = .False. - call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,& - N_det,size(eigenvectors,1)) - do j=1,N_det - ! Select at least n_states states with S^2 values closed to "expected_s2" - if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then - i_state += 1 - index_good_state_array(i_state) = j - good_state_array(j) = .True. - endif - if (i_state==N_states) then - exit - endif - enddo - if (i_state /= 0) then - ! Fill the first "i_state" states that have a correct S^2 value - do j = 1, i_state - do i=1,N_det - CI_eigenvectors_dressed(i,j) = eigenvectors(i,index_good_state_array(j)) - enddo - CI_electronic_energy_dressed(j) = eigenvalues(index_good_state_array(j)) - CI_eigenvectors_s2_dressed(j) = s2_eigvalues(index_good_state_array(j)) - enddo - i_other_state = 0 - do j = 1, N_det - if(good_state_array(j))cycle - i_other_state +=1 - if(i_state+i_other_state.gt.n_states_diag)then - exit - endif - do i=1,N_det - CI_eigenvectors_dressed(i,i_state+i_other_state) = eigenvectors(i,j) - enddo - CI_electronic_energy_dressed(i_state+i_other_state) = eigenvalues(j) - CI_eigenvectors_s2_dressed(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) - enddo - - else - print*,'' - print*,'!!!!!!!! WARNING !!!!!!!!!' - print*,' Within the ',N_det,'determinants selected' - print*,' and the ',N_states_diag,'states requested' - print*,' We did not find any state with S^2 values close to ',expected_s2 - print*,' We will then set the first N_states eigenvectors of the H matrix' - print*,' as the CI_eigenvectors_dressed' - print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space' - print*,'' - do j=1,min(N_states_diag,N_det) - do i=1,N_det - CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) - enddo - CI_electronic_energy_dressed(j) = eigenvalues(j) - CI_eigenvectors_s2_dressed(j) = s2_eigvalues(j) - enddo - endif - deallocate(index_good_state_array,good_state_array) - deallocate(s2_eigvalues) - else - call u_0_S2_u_0(CI_eigenvectors_s2_dressed,eigenvectors,N_det,psi_det,N_int,& - min(N_det,N_states_diag),size(eigenvectors,1)) - ! Select the "N_states_diag" states of lowest energy - do j=1,min(N_det,N_states_diag) - do i=1,N_det - CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) - enddo - CI_electronic_energy_dressed(j) = eigenvalues(j) - enddo - endif - deallocate(eigenvectors,eigenvalues) - endif - -END_PROVIDER - -BEGIN_PROVIDER [ double precision, CI_energy_dressed, (N_states_diag) ] - implicit none - BEGIN_DOC - ! N_states lowest eigenvalues of the dressed CI matrix - END_DOC - - integer :: j - character*(8) :: st - call write_time(6) - do j=1,min(N_det,N_states) - write(st,'(I4)') j - CI_energy_dressed(j) = CI_electronic_energy_dressed(j) + nuclear_repulsion - call write_double(6,CI_energy_dressed(j),'Energy of state '//trim(st)) - call write_double(6,CI_eigenvectors_s2_dressed(j),'S^2 of state '//trim(st)) - enddo - -END_PROVIDER - -subroutine diagonalize_CI_dressed(lambda) - implicit none - BEGIN_DOC -! Replace the coefficients of the CI states by the coefficients of the -! eigenstates of the CI matrix - END_DOC - double precision, intent(in) :: lambda - integer :: i,j - do j=1,N_states - do i=1,N_det - psi_coef(i,j) = lambda * CI_eigenvectors_dressed(i,j) + (1.d0 - lambda) * psi_coef(i,j) - enddo - call normalize(psi_coef(1,j), N_det) - enddo - SOFT_TOUCH psi_coef - -end logical function is_generable(det1, det2, Nint) diff --git a/plugins/MRCC_Utils/multi_state.irp.f b/plugins/MRCC_Utils/multi_state.irp.f deleted file mode 100644 index b4a2a3cb..00000000 --- a/plugins/MRCC_Utils/multi_state.irp.f +++ /dev/null @@ -1,101 +0,0 @@ -subroutine multi_state(CI_electronic_energy_dressed_,CI_eigenvectors_dressed_,LDA) - implicit none - BEGIN_DOC - ! Multi-state mixing - END_DOC - integer, intent(in) :: LDA - double precision, intent(inout) :: CI_electronic_energy_dressed_(N_states) - double precision, intent(inout) :: CI_eigenvectors_dressed_(LDA,N_states) - double precision, allocatable :: h(:,:,:), s(:,:), Psi(:,:), H_Psi(:,:,:), H_jj(:) - - allocate( h(N_states,N_states,0:N_states), s(N_states,N_states) ) - allocate( Psi(LDA,N_states), H_Psi(LDA,N_states,0:N_states) ) - allocate (H_jj(LDA) ) - -! e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/u_dot_u(u_0(1,i),n) - - integer :: i,j,k,istate - double precision :: U(N_states,N_states), Vt(N_states,N_states), D(N_states) - double precision, external :: diag_H_mat_elem - do istate=1,N_states - do i=1,N_det - H_jj(i) = diag_H_mat_elem(psi_det(1,1,i),N_int) - enddo - - do i=1,N_det_ref - H_jj(idx_ref(i)) += delta_ii(istate,i) - enddo - - do k=1,N_states - do i=1,N_det - Psi(i,k) = CI_eigenvectors_dressed_(i,k) - enddo - enddo - call H_u_0_mrcc_nstates(H_Psi(1,1,istate),Psi,H_jj,N_det,psi_det,N_int,istate,N_states,LDA) - - do k=1,N_states - do i=1,N_states - double precision, external :: u_dot_v - h(i,k,istate) = u_dot_v(Psi(1,i), H_Psi(1,k,istate), N_det) - enddo - enddo - enddo - - do k=1,N_states - do i=1,N_states - s(i,k) = u_dot_v(Psi(1,i), Psi(1,k), N_det) - enddo - enddo - - print *, s(:,:) - print *, '' - - h(:,:,0) = h(:,:,1) - do istate=2,N_states - U(:,:) = h(:,:,0) - call dgemm('N','N',N_states,N_states,N_states,1.d0,& - U, size(U,1), h(1,1,istate), size(h,1), 0.d0, & - h(1,1,0), size(Vt,1)) - enddo - - call svd(h(1,1,0), size(h,1), U, size(U,1), D, Vt, size(Vt,1), N_states, N_states) - do k=1,N_states - D(k) = D(k)**(1./dble(N_states)) - if (D(k) > 0.d0) then - D(k) = -D(k) - endif - enddo - - do j=1,N_states - do i=1,N_states - h(i,j,0) = 0.d0 - do k=1,N_states - h(i,j,0) += U(i,k) * D(k) * Vt(k,j) - enddo - enddo - enddo - - print *, h(:,:,0) - print *,'' - - integer :: LWORK, INFO - double precision, allocatable :: WORK(:) - LWORK=3*N_states - allocate (WORK(LWORK)) - call dsygv(1, 'V', 'U', N_states, h(1,1,0), size(h,1), s, size(s,1), D, WORK, LWORK, INFO) - deallocate(WORK) - - do j=1,N_states - do i=1,N_det - CI_eigenvectors_dressed_(i,j) = 0.d0 - do k=1,N_states - CI_eigenvectors_dressed_(i,j) += Psi(i,k) * h(k,j,0) - enddo - enddo - CI_electronic_energy_dressed_(j) = D(j) - enddo - - - deallocate (h,s, H_jj) - deallocate( Psi, H_Psi ) -end diff --git a/plugins/Properties/NEEDED_CHILDREN_MODULES b/plugins/Properties/NEEDED_CHILDREN_MODULES index 34de8ddb..2a87d1c1 100644 --- a/plugins/Properties/NEEDED_CHILDREN_MODULES +++ b/plugins/Properties/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants Davidson +Determinants DavidsonUndressed diff --git a/plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES b/plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES index 107c1643..22828878 100644 --- a/plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES +++ b/plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Psiref_Utils Davidson +Psiref_Utils DavidsonUndressed diff --git a/plugins/UndressedMethod/NEEDED_CHILDREN_MODULES b/plugins/UndressedMethod/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/plugins/UndressedMethod/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ + diff --git a/plugins/UndressedMethod/README.rst b/plugins/UndressedMethod/README.rst new file mode 100644 index 00000000..1b739e5c --- /dev/null +++ b/plugins/UndressedMethod/README.rst @@ -0,0 +1,14 @@ +=============== +UndressedMethod +=============== + +Defines a null dressing vector + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. diff --git a/plugins/UndressedMethod/null_dressing_vector.irp.f b/plugins/UndressedMethod/null_dressing_vector.irp.f new file mode 100644 index 00000000..faffe964 --- /dev/null +++ b/plugins/UndressedMethod/null_dressing_vector.irp.f @@ -0,0 +1,10 @@ + BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ] +&BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] + implicit none + BEGIN_DOC + ! Null dressing vectors + END_DOC + dressing_column_h(:,:) = 0.d0 + dressing_column_s(:,:) = 0.d0 +END_PROVIDER + diff --git a/plugins/mrcepa0/NEEDED_CHILDREN_MODULES b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES index 8b6c5a18..fe8255d1 100644 --- a/plugins/mrcepa0/NEEDED_CHILDREN_MODULES +++ b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils ZMQ +Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils ZMQ diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 727bdba7..951c8c4c 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -74,10 +74,8 @@ BEGIN_PROVIDER [ double precision, mrcc_norm_acc, (0:N_det_non_ref, N_states) ] END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_ij_mrcc_sto,(N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_mrcc_sto, (N_states, N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ij_s2_mrcc_sto, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_s2_mrcc_sto, (N_states, N_det_ref) ] + BEGIN_PROVIDER [ double precision, delta_ij_mrcc_sto,(N_states,N_det_non_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2_mrcc_sto, (N_states,N_det_non_ref) ] use bitmasks implicit none integer :: gen, h, p, n, t, i, j, h1, h2, p1, p2, s1, s2, iproc @@ -94,10 +92,8 @@ END_PROVIDER read(*,*) n_in_teeth !n_in_teeth = 2 in_teeth_step = 1d0 / dfloat(n_in_teeth) -!double precision :: delta_ij_mrcc_tmp,(N_states,N_det_non_ref,N_det_ref) ] - !double precision :: delta_ii_mrcc_tmp, (N_states,N_det_ref) ] - !double precision :: delta_ij_s2_mrcc_tmp(N_states,N_det_non_ref,N_det_ref) - !double precision :: delta_ii_s2_mrcc_tmp(N_states, N_det_ref) + !double precision :: delta_ij_mrcc_tmp,(N_states,N_det_non_ref) + !double precision :: delta_ij_s2_mrcc_tmp(N_states,N_det_non_ref) coefs = 0d0 coefs(:mrcc_teeth(1,1)-1) = 1d0 @@ -144,15 +140,13 @@ END_PROVIDER delta_ij_mrcc_sto = 0d0 - delta_ii_mrcc_sto = 0d0 delta_ij_s2_mrcc_sto = 0d0 - delta_ii_s2_mrcc_sto = 0d0 PROVIDE dij provide hh_shortcut psi_det_size! lambda_mrcc !$OMP PARALLEL DO default(none) schedule(dynamic) & !$OMP shared(psi_ref, psi_non_ref, hh_exists, pp_exists, N_int, hh_shortcut) & - !$OMP shared(N_det_generators, coefs,N_det_non_ref, N_det_ref, delta_ii_mrcc_sto, delta_ij_mrcc_sto) & - !$OMP shared(contrib,psi_det_generators, delta_ii_s2_mrcc_sto, delta_ij_s2_mrcc_sto) & + !$OMP shared(N_det_generators, coefs,N_det_non_ref, delta_ij_mrcc_sto) & + !$OMP shared(contrib,psi_det_generators, delta_ij_s2_mrcc_sto) & !$OMP private(i,j,curnorm,myCoef, h, n, mask, omask, buf, ok, iproc) do gen= 1,N_det_generators if(coefs(gen) == 0d0) cycle @@ -174,8 +168,8 @@ END_PROVIDER end do n = n - 1 if(n /= 0) then - call mrcc_part_dress(delta_ij_mrcc_sto, delta_ii_mrcc_sto, delta_ij_s2_mrcc_sto, & - delta_ii_s2_mrcc_sto, gen,n,buf,N_int,omask,myCoef,contrib) + call mrcc_part_dress(delta_ij_mrcc_sto, delta_ij_s2_mrcc_sto, & + gen,n,buf,N_int,omask,myCoef,contrib) endif end do deallocate(buf) @@ -185,21 +179,17 @@ END_PROVIDER curnorm = 0d0 - do i=1,N_det_ref do j=1,N_det_non_ref - curnorm += delta_ij_mrcc_sto(1, j, i)**2 + curnorm += delta_ij_mrcc_sto(1,j)*delta_ij_mrcc_sto(1,j) end do - end do - print *, "NORM DELTA ", curnorm**0.5d0 + print *, "NORM DELTA ", dsqrt(curnorm) END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_ij_cancel, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_cancel, (N_states, N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ij_s2_cancel, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_s2_cancel, (N_states, N_det_ref) ] + BEGIN_PROVIDER [ double precision, delta_ij_cancel, (N_states,N_det_non_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2_cancel, (N_states,N_det_non_ref) ] use bitmasks implicit none @@ -216,15 +206,19 @@ END_PROVIDER integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2),inac, virt integer, external :: get_index_in_psi_det_sorted_bit, searchDet,detCmp logical, external :: is_in_wavefunction + double precision :: c0(N_states) provide dij delta_ij_cancel = 0d0 - delta_ii_cancel = 0d0 + + do i_state = 1, N_states + c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) + enddo do i=1,N_det_ref !$OMP PARALLEL DO default(shared) private(kk, k, blok, exc_Ik,det_tmp2,ok,deg,phase_Ik, l,ll) & - !$OMP private(contrib, contrib_s2, i_state) + !$OMP private(contrib, contrib_s2, i_state, c0) do kk = 1, nlink(i) k = det_cepa0_idx(linked(kk, i)) blok = blokMwen(kk, i) @@ -244,21 +238,10 @@ END_PROVIDER do i_state = 1, N_states contrib = (dij(j, l, i_state) - dij(i, k, i_state)) * delta_cas(i,j,i_state)! * Hla *phase_ia * phase_ik contrib_s2 = dij(j, l, i_state) - dij(i, k, i_state)! * Sla*phase_ia * phase_ik - if(dabs(psi_ref_coef(i,i_state)).ge.1.d-3) then - !$OMP ATOMIC - delta_ij_cancel(i_state,l,i) += contrib - !$OMP ATOMIC - delta_ij_s2_cancel(i_state,l,i) += contrib_s2 - !$OMP ATOMIC - delta_ii_cancel(i_state,i) -= contrib / psi_ref_coef(i, i_state) * psi_non_ref_coef(l,i_state) - !$OMP ATOMIC - delta_ii_s2_cancel(i_state,i) -= contrib_s2 / psi_ref_coef(i, i_state) * psi_non_ref_coef(l,i_state) - else - !$OMP ATOMIC - delta_ij_cancel(i_state,l,i) += contrib * 0.5d0 - !$OMP ATOMIC - delta_ij_s2_cancel(i_state,l,i) += contrib_s2 * 0.5d0 - endif + !$OMP ATOMIC + delta_ij_cancel(i_state,l) += contrib * psi_ref_coef(i,i_state) * c0(i_state) + !$OMP ATOMIC + delta_ij_s2_cancel(i_state,l) += contrib_s2* psi_ref_coef(i,i_state) * c0(i_state) end do end do end do @@ -268,10 +251,8 @@ END_PROVIDER END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_ij_mrcc, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_mrcc, (N_states, N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ij_s2_mrcc, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_s2_mrcc, (N_states, N_det_ref) ] + BEGIN_PROVIDER [ double precision, delta_ij_mrcc, (N_states,N_det_non_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2_mrcc, (N_states,N_det_non_ref) ] use bitmasks implicit none integer :: gen, h, p, n, t, i, h1, h2, p1, p2, s1, s2, iproc @@ -286,14 +267,12 @@ END_PROVIDER contrib = 0d0 delta_ij_mrcc = 0d0 - delta_ii_mrcc = 0d0 delta_ij_s2_mrcc = 0d0 - delta_ii_s2_mrcc = 0d0 !$OMP PARALLEL DO default(none) schedule(dynamic) & !$OMP shared(contrib,psi_det_generators, N_det_generators, hh_exists, pp_exists, N_int, hh_shortcut) & - !$OMP shared(N_det_non_ref, N_det_ref, delta_ii_mrcc, delta_ij_mrcc, delta_ii_s2_mrcc, delta_ij_s2_mrcc) & + !$OMP shared(N_det_non_ref, N_det_ref, delta_ij_mrcc, delta_ij_s2_mrcc) & !$OMP private(h, n, mask, omask, buf, ok, iproc) do gen= 1, N_det_generators allocate(buf(N_int, 2, N_det_non_ref)) @@ -313,7 +292,7 @@ END_PROVIDER n = n - 1 if(n /= 0) then - call mrcc_part_dress(delta_ij_mrcc, delta_ii_mrcc, delta_ij_s2_mrcc, delta_ii_s2_mrcc, gen,n,buf,N_int,omask,1d0,contrib) + call mrcc_part_dress(delta_ij_mrcc, delta_ij_s2_mrcc, gen,n,buf,N_int,omask,1d0,contrib) endif end do @@ -324,20 +303,18 @@ END_PROVIDER ! subroutine blit(b1, b2) -! double precision :: b1(N_states,N_det_non_ref,N_det_ref), b2(N_states,N_det_non_ref,N_det_ref) +! double precision :: b1(N_states,N_det_non_ref), b2(N_states,N_det_non_ref) ! b1 = b1 + b2 ! end subroutine -subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_generator,n_selected,det_buffer,Nint,key_mask,coef,contrib) +subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_buffer,Nint,key_mask,coef,contrib) use bitmasks implicit none integer, intent(in) :: i_generator,n_selected, Nint - double precision, intent(inout) :: delta_ij_(N_states,N_det_non_ref,N_det_ref) - double precision, intent(inout) :: delta_ii_(N_states,N_det_ref) - double precision, intent(inout) :: delta_ij_s2_(N_states,N_det_non_ref,N_det_ref) - double precision, intent(inout) :: delta_ii_s2_(N_states,N_det_ref) + double precision, intent(inout) :: delta_ij_(N_states,N_det_non_ref) + double precision, intent(inout) :: delta_ij_s2_(N_states,N_det_non_ref) integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) integer :: i,j,k,l,m @@ -399,6 +376,11 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen deallocate(microlist, idx_microlist) + double precision :: c0(N_states) + do i_state=1,N_states + c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) + enddo + allocate (dIa_hla(N_states,N_det_non_ref), dIa_sla(N_states,N_det_non_ref)) ! |I> @@ -436,8 +418,8 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen do i_alpha=1,N_tq - if(key_mask(1,1) /= 0) then - call getMobiles(tq(1,1,i_alpha), key_mask, mobiles, Nint) + if(key_mask(1,1) /= 0) then + call getMobiles(tq(1,1,i_alpha), key_mask, mobiles, Nint) if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then smallerlist = mobiles(1) @@ -445,7 +427,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen smallerlist = mobiles(2) end if - + do l=0,N_microlist(smallerlist)-1 microlist_zero(:,:,ptr_microlist(1) + l) = microlist(:,:,ptr_microlist(smallerlist) + l) idx_microlist_zero(ptr_microlist(1) + l) = idx_microlist(ptr_microlist(smallerlist) + l) @@ -467,9 +449,9 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen k_sd = idx_alpha(l_sd) call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hij_cache(k_sd)) call get_s2(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,sij_cache(k_sd)) - !if(sij_cache(k_sd) /= 0D0) PRINT *, "SIJ ", sij_cache(k_sd) + !if(sij_cache(k_sd) /= 0D0) PRINT *, "SIJ ", sij_cache(k_sd) enddo - + ! |I> do i_I=1,N_det_ref ! Find triples and quadruple grand parents @@ -484,12 +466,12 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen ! |alpha> do k_sd=1,idx_alpha(0) - + call get_excitation_degree(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(k_sd)),degree,Nint) if (degree > 2) then cycle endif - + ! ! |l> = Exc(k -> alpha) |I> @@ -499,7 +481,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen tmp_det(k,1) = psi_ref(k,1,i_I) tmp_det(k,2) = psi_ref(k,2,i_I) enddo - logical :: ok + logical :: ok call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, Nint) do i_state=1,N_states @@ -510,7 +492,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen do i_state=1,N_states dka(i_state) = 0.d0 enddo - + if (ok) then do l_sd=k_sd+1,idx_alpha(0) call get_excitation_degree(tmp_det,psi_non_ref(1,1,idx_alpha(l_sd)),degree,Nint) @@ -522,40 +504,40 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen exit endif enddo - + else if (perturbative_triples) then - ! Linked - - hka = hij_cache(idx_alpha(k_sd)) - if (dabs(hka) > 1.d-12) then - call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv) - - do i_state=1,N_states - ASSERT (Delta_E_inv(i_state) < 0.d0) - dka(i_state) = hka / Delta_E_inv(i_state) - enddo - endif - + ! Linked + + hka = hij_cache(idx_alpha(k_sd)) + if (dabs(hka) > 1.d-12) then + call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv) + + do i_state=1,N_states + ASSERT (Delta_E_inv(i_state) < 0.d0) + dka(i_state) = hka / Delta_E_inv(i_state) + enddo + endif + endif - + if (perturbative_triples.and. (degree2 == 1) ) then - call i_h_j(psi_ref(1,1,i_I),tmp_det,Nint,hka) - hka = hij_cache(idx_alpha(k_sd)) - hka - if (dabs(hka) > 1.d-12) then - call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv) - do i_state=1,N_states - ASSERT (Delta_E_inv(i_state) < 0.d0) - dka(i_state) = hka / Delta_E_inv(i_state) - enddo - endif - + call i_h_j(psi_ref(1,1,i_I),tmp_det,Nint,hka) + hka = hij_cache(idx_alpha(k_sd)) - hka + if (dabs(hka) > 1.d-12) then + call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv) + do i_state=1,N_states + ASSERT (Delta_E_inv(i_state) < 0.d0) + dka(i_state) = hka / Delta_E_inv(i_state) + enddo + endif + endif - + do i_state=1,N_states dIa(i_state) = dIa(i_state) + dIk(i_state) * dka(i_state) enddo enddo - + do i_state=1,N_states ci_inv(i_state) = psi_ref_coef_inv(i_I,i_state) enddo @@ -569,39 +551,17 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen enddo enddo do i_state=1,N_states - if(dabs(psi_ref_coef(1,i_state)).ge.1.d-3)then - do l_sd=1,idx_alpha(0) - k_sd = idx_alpha(l_sd) - p1 = 1 - hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) / psi_ref_coef(p1,i_state) - sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) / psi_ref_coef(p1,i_state) - !$OMP ATOMIC - contrib(i_state) += hdress * psi_ref_coef(p1, i_state) * psi_non_ref_coef(k_sd, i_state) - !$OMP ATOMIC - delta_ij_(i_state,k_sd,p1) += hdress - !$OMP ATOMIC - !delta_ii_(i_state,i_I) = delta_ii_(i_state,i_I) - dIa_hla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) - delta_ii_(i_state,p1) -= hdress / psi_ref_coef(p1,i_state) * psi_non_ref_coef_transp(i_state,k_sd) - !$OMP ATOMIC - delta_ij_s2_(i_state,k_sd,p1) += sdress - !$OMP ATOMIC - !delta_ii_s2_(i_state,i_I) = delta_ii_s2_(i_state,i_I) - dIa_sla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) - delta_ii_s2_(i_state,p1) -= sdress / psi_ref_coef(p1,i_state) * psi_non_ref_coef_transp(i_state,k_sd) - enddo - else - !stop "dress with coef < 1d-3" - delta_ii_(i_state,1) = 0.d0 - do l_sd=1,idx_alpha(0) - k_sd = idx_alpha(l_sd) - p1 = 1 - hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) / psi_ref_coef(p1,i_state) - sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) / psi_ref_coef(p1,i_state) - !$OMP ATOMIC - delta_ij_(i_state,k_sd,p1) = delta_ij_(i_state,k_sd,p1) + 0.5d0*hdress - !$OMP ATOMIC - delta_ij_s2_(i_state,k_sd,p1) = delta_ij_s2_(i_state,k_sd,p1) + 0.5d0*sdress - enddo - endif + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) + sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) + !$OMP ATOMIC + contrib(i_state) += hdress * psi_coef(dressed_column_idx(i_state), i_state) * psi_non_ref_coef(k_sd, i_state) + !$OMP ATOMIC + delta_ij_(i_state,k_sd) += hdress + !$OMP ATOMIC + delta_ij_s2_(i_state,k_sd) += sdress + enddo enddo enddo enddo @@ -611,15 +571,13 @@ end -subroutine mrcc_part_dress_1c(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_generator,n_selected,det_buffer,Nint,key_mask,contrib) +subroutine mrcc_part_dress_1c(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_buffer,Nint,key_mask,contrib) use bitmasks implicit none integer, intent(in) :: i_generator,n_selected, Nint double precision, intent(inout) :: delta_ij_(N_states,N_det_non_ref) - double precision, intent(inout) :: delta_ii_(N_states) double precision, intent(inout) :: delta_ij_s2_(N_states,N_det_non_ref) - double precision, intent(inout) :: delta_ii_s2_(N_states) integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) integer :: i,j,k,l,m @@ -715,6 +673,11 @@ subroutine mrcc_part_dress_1c(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_ end if end if + double precision :: c0(N_states) + do i_state=1,N_states + c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) + enddo + do i_alpha=1,N_tq if(key_mask(1,1) /= 0) then @@ -850,39 +813,17 @@ subroutine mrcc_part_dress_1c(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_ enddo enddo do i_state=1,N_states - if(dabs(psi_ref_coef(1,i_state)).ge.1.d-3)then do l_sd=1,idx_alpha(0) k_sd = idx_alpha(l_sd) - p1 = 1 - hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) / psi_ref_coef(p1,i_state) - sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) / psi_ref_coef(p1,i_state) + hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) + sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) !$OMP ATOMIC - contrib(i_state) += hdress * psi_ref_coef(p1, i_state) * psi_non_ref_coef(k_sd, i_state) + contrib(i_state) += hdress * psi_ref_coef(dressed_column_idx(i_state), i_state) * psi_non_ref_coef(k_sd, i_state) !$OMP ATOMIC delta_ij_(i_state,k_sd) += hdress !$OMP ATOMIC - !delta_ii_(i_state,i_I) = delta_ii_(i_state,i_I) - dIa_hla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) - delta_ii_(i_state) -= hdress / psi_ref_coef(p1,i_state) * psi_non_ref_coef_transp(i_state,k_sd) - !$OMP ATOMIC delta_ij_s2_(i_state,k_sd) += sdress - !$OMP ATOMIC - !delta_ii_s2_(i_state,i_I) = delta_ii_s2_(i_state,i_I) - dIa_sla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) - delta_ii_s2_(i_state) -= sdress / psi_ref_coef(p1,i_state) * psi_non_ref_coef_transp(i_state,k_sd) enddo - else - !stop "dress with coef < 1d-3" - delta_ii_(i_state) = 0.d0 - do l_sd=1,idx_alpha(0) - k_sd = idx_alpha(l_sd) - p1 = 1 - hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) / psi_ref_coef(p1,i_state) - sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) / psi_ref_coef(p1,i_state) - !$OMP ATOMIC - delta_ij_(i_state,k_sd) = delta_ij_(i_state,k_sd) + 0.5d0*hdress - !$OMP ATOMIC - delta_ij_s2_(i_state,k_sd) = delta_ij_s2_(i_state,k_sd) + 0.5d0*sdress - enddo - endif enddo enddo enddo @@ -900,10 +841,8 @@ end END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_ij_mrcc_zmq, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_mrcc_zmq, (N_states, N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ij_s2_mrcc_zmq, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_s2_mrcc_zmq, (N_states, N_det_ref) ] + BEGIN_PROVIDER [ double precision, delta_ij_mrcc_zmq, (N_states,N_det_non_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2_mrcc_zmq, (N_states,N_det_non_ref) ] use bitmasks implicit none @@ -917,9 +856,7 @@ end delta_ij_mrcc_zmq = 0d0 - delta_ii_mrcc_zmq = 0d0 delta_ij_s2_mrcc_zmq = 0d0 - delta_ii_s2_mrcc_zmq = 0d0 !call random_seed() E_CI_before = mrcc_E0_denominator(1) + nuclear_repulsion @@ -935,142 +872,67 @@ end call ZMQ_mrcc(E_CI_before, mrcc, delta_ij_mrcc_zmq, delta_ij_s2_mrcc_zmq, abs(relative_error)) mrcc_previous_E(:) = mrcc_E0_denominator(:) - do i=N_det_non_ref,1,-1 - delta_ii_mrcc_zmq(:,1) -= delta_ij_mrcc_zmq(:, i, 1) / psi_ref_coef(1,1) * psi_non_ref_coef(i, 1) - delta_ii_s2_mrcc_zmq(:,1) -= delta_ij_s2_mrcc_zmq(:, i, 1) / psi_ref_coef(1,1) * psi_non_ref_coef(i, 1) - end do END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii, (N_states, N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ij_s2, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_s2, (N_states, N_det_ref) ] + BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det_non_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2, (N_states,N_det_non_ref) ] use bitmasks implicit none integer :: i, j, i_state - !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc, 4=stoch if(mrmode == 4) then - do i = 1, N_det_ref - do i_state = 1, N_states - delta_ii(i_state,i)= delta_ii_mrcc_sto(i_state,i) - delta_ii_s2(i_state,i)= delta_ii_s2_mrcc_sto(i_state,i) - enddo do j = 1, N_det_non_ref do i_state = 1, N_states - delta_ij(i_state,j,i) = delta_ij_mrcc_sto(i_state,j,i) - delta_ij_s2(i_state,j,i) = delta_ij_s2_mrcc_sto(i_state,j,i) + delta_ij(i_state,j) = delta_ij_mrcc_sto(i_state,j) + delta_ij_s2(i_state,j) = delta_ij_s2_mrcc_sto(i_state,j) enddo end do - end do ! else if(mrmode == 10) then -! do i = 1, N_det_ref -! do i_state = 1, N_states -! delta_ii(i_state,i)= delta_ii_mrsc2(i_state,i) -! delta_ii_s2(i_state,i)= delta_ii_s2_mrsc2(i_state,i) -! enddo ! do j = 1, N_det_non_ref ! do i_state = 1, N_states -! delta_ij(i_state,j,i) = delta_ij_mrsc2(i_state,j,i) -! delta_ij_s2(i_state,j,i) = delta_ij_s2_mrsc2(i_state,j,i) +! delta_ij(i_state,j) = delta_ij_mrsc2(i_state,j) +! delta_ij_s2(i_state,j) = delta_ij_s2_mrsc2(i_state,j) ! enddo ! end do -! end do else if(mrmode == 5) then - do i = 1, N_det_ref - do i_state = 1, N_states - delta_ii(i_state,i)= delta_ii_mrcc_zmq(i_state,i) - delta_ii_s2(i_state,i)= delta_ii_s2_mrcc_zmq(i_state,i) - enddo do j = 1, N_det_non_ref do i_state = 1, N_states - delta_ij(i_state,j,i) = delta_ij_mrcc_zmq(i_state,j,i) - delta_ij_s2(i_state,j,i) = delta_ij_s2_mrcc_zmq(i_state,j,i) + delta_ij(i_state,j) = delta_ij_mrcc_zmq(i_state,j) + delta_ij_s2(i_state,j) = delta_ij_s2_mrcc_zmq(i_state,j) enddo end do - end do else if(mrmode == 3) then - do i = 1, N_det_ref - do i_state = 1, N_states - delta_ii(i_state,i)= delta_ii_mrcc(i_state,i) - delta_ii_s2(i_state,i)= delta_ii_s2_mrcc(i_state,i) - enddo do j = 1, N_det_non_ref do i_state = 1, N_states - delta_ij(i_state,j,i) = delta_ij_mrcc(i_state,j,i) - delta_ij_s2(i_state,j,i) = delta_ij_s2_mrcc(i_state,j,i) + delta_ij(i_state,j) = delta_ij_mrcc(i_state,j) + delta_ij_s2(i_state,j) = delta_ij_s2_mrcc(i_state,j) enddo end do - end do - - ! =-=-= BEGIN STATE AVERAGE -! do i = 1, N_det_ref -! delta_ii(:,i)= delta_ii_mrcc(1,i) -! delta_ii_s2(:,i)= delta_ii_s2_mrcc(1,i) -! do i_state = 2, N_states -! delta_ii(:,i) += delta_ii_mrcc(i_state,i) -! delta_ii_s2(:,i) += delta_ii_s2_mrcc(i_state,i) -! enddo -! do j = 1, N_det_non_ref -! delta_ij(:,j,i) = delta_ij_mrcc(1,j,i) -! delta_ij_s2(:,j,i) = delta_ij_s2_mrcc(1,j,i) -! do i_state = 2, N_states -! delta_ij(:,j,i) += delta_ij_mrcc(i_state,j,i) -! delta_ij_s2(:,j,i) += delta_ij_s2_mrcc(i_state,j,i) -! enddo -! end do -! end do -! delta_ij = delta_ij * (1.d0/dble(N_states)) -! delta_ii = delta_ii * (1.d0/dble(N_states)) - ! =-=-= END STATE AVERAGE - ! - ! do i = 1, N_det_ref - ! delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) - delta_sub_ii(i,i_state) - ! do j = 1, N_det_non_ref - ! delta_ij(i_state,j,i) = delta_mrcepa0_ij(i,j,i_state) - delta_sub_ij(i,j,i_state) - ! end do - ! end do else if(mrmode == 2) then - do i = 1, N_det_ref - do i_state = 1, N_states - delta_ii(i_state,i)= delta_ii_old(i_state,i) - delta_ii_s2(i_state,i)= delta_ii_s2_old(i_state,i) - enddo do j = 1, N_det_non_ref do i_state = 1, N_states - delta_ij(i_state,j,i) = delta_ij_old(i_state,j,i) - delta_ij_s2(i_state,j,i) = delta_ij_s2_old(i_state,j,i) + delta_ij(i_state,j) = delta_ij_old(i_state,j) + delta_ij_s2(i_state,j) = delta_ij_s2_old(i_state,j) enddo end do - end do else if(mrmode == 1) then - do i = 1, N_det_ref - do i_state = 1, N_states - delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) - delta_ii_s2(i_state,i)= delta_mrcepa0_ii_s2(i,i_state) - enddo do j = 1, N_det_non_ref do i_state = 1, N_states - delta_ij(i_state,j,i) = delta_mrcepa0_ij(i,j,i_state) - delta_ij_s2(i_state,j,i) = delta_mrcepa0_ij_s2(i,j,i_state) + delta_ij(i_state,j) = delta_mrcepa0_ij(j,i_state) + delta_ij_s2(i_state,j) = delta_mrcepa0_ij_s2(j,i_state) enddo end do - end do else stop "invalid mrmode" end if !if(mrmode == 2 .or. mrmode == 3) then - ! do i = 1, N_det_ref - ! do i_state = 1, N_states - ! delta_ii(i_state,i) += delta_ii_cancel(i_state,i) - ! enddo ! do j = 1, N_det_non_ref ! do i_state = 1, N_states - ! delta_ij(i_state,j,i) += delta_ij_cancel(i_state,j,i) + ! delta_ij(i_state,j) += delta_ij_cancel(i_state,j) ! enddo ! end do - ! end do !end if END_PROVIDER @@ -1352,10 +1214,8 @@ subroutine getHP(a,h,p,Nint) end subroutine - BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii, (N_det_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij_s2, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii_s2, (N_det_ref,N_states) ] + BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij, (N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij_s2, (N_det_non_ref,N_states) ] use bitmasks implicit none @@ -1363,7 +1223,7 @@ end subroutine integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_, sortRefIdx(N_det_ref) logical :: ok double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) - double precision :: contrib, contrib2, contrib_s2, contrib2_s2, HIIi, HJk, wall + double precision :: contrib, contrib_s2, HIIi, HJk, wall integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2) integer(bit_kind),allocatable :: sortRef(:,:,:) @@ -1385,20 +1245,23 @@ end subroutine idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i enddo + double precision :: c0(N_states) + do i_state=1,N_states + c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) + enddo + ! To provide everything contrib = dij(1, 1, 1) - delta_mrcepa0_ii(:,:) = 0d0 - delta_mrcepa0_ij(:,:,:) = 0d0 - delta_mrcepa0_ii_s2(:,:) = 0d0 - delta_mrcepa0_ij_s2(:,:,:) = 0d0 + delta_mrcepa0_ij(:,:) = 0d0 + delta_mrcepa0_ij_s2(:,:) = 0d0 do i_state = 1, N_states - !$OMP PARALLEL DO default(none) schedule(dynamic) shared(delta_mrcepa0_ij, delta_mrcepa0_ii, delta_mrcepa0_ij_s2, delta_mrcepa0_ii_s2) & - !$OMP private(m,i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib,contrib2,contrib_s2,contrib2_s2) & + !$OMP PARALLEL DO default(none) schedule(dynamic) shared(delta_mrcepa0_ij, delta_mrcepa0_ij_s2) & + !$OMP private(m,i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib,contrib_s2) & !$OMP shared(active_sorb, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef, cepa0_shortcut, det_cepa0_active) & !$OMP shared(N_det_ref, N_det_non_ref,N_int,det_cepa0_idx,lambda_mrcc,det_ref_active, delta_cas, delta_cas_s2) & - !$OMP shared(notf,i_state, sortRef, sortRefIdx, dij) + !$OMP shared(notf,i_state, sortRef, sortRefIdx, dij,c0) do blok=1,cepa0_shortcut(0) do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 do II=1,N_det_ref @@ -1438,23 +1301,12 @@ end subroutine !$OMP ATOMIC notf = notf+1 -! call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) contrib = delta_cas(II, J, i_state)* dij(J, det_cepa0_idx(k), i_state) contrib_s2 = delta_cas_s2(II, J, i_state) * dij(J, det_cepa0_idx(k), i_state) - if(dabs(psi_ref_coef(J,i_state)).ge.1.d-3) then - contrib2 = contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(i),i_state) - contrib2_s2 = contrib_s2 / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(i),i_state) - !$OMP ATOMIC - delta_mrcepa0_ii(J,i_state) -= contrib2 - delta_mrcepa0_ii_s2(J,i_state) -= contrib2_s2 - else - contrib = contrib * 0.5d0 - contrib_s2 = contrib_s2 * 0.5d0 - end if !$OMP ATOMIC - delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib - delta_mrcepa0_ij_s2(J, det_cepa0_idx(i), i_state) += contrib_s2 + delta_mrcepa0_ij(det_cepa0_idx(i), i_state) += contrib * c0(i_state) * psi_ref_coef(J,i_state) + delta_mrcepa0_ij_s2(det_cepa0_idx(i), i_state) += contrib_s2 * c0(i_state) * psi_ref_coef(J,i_state) end do kloop end do @@ -1469,8 +1321,7 @@ end subroutine END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_sub_ij, (N_det_ref,N_det_non_ref,N_states) ] -&BEGIN_PROVIDER [ double precision, delta_sub_ii, (N_det_ref, N_states) ] +BEGIN_PROVIDER [ double precision, delta_sub_ij, (N_det_non_ref,N_states) ] use bitmasks implicit none @@ -1478,7 +1329,7 @@ END_PROVIDER integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ logical :: ok double precision :: phase_Ji, phase_Ik, phase_Ii - double precision :: contrib, contrib2, delta_IJk, HJk, HIk, HIl + double precision :: contrib, delta_IJk, HJk, HIk, HIl integer, dimension(0:2,2,2) :: exc_Ik, exc_Ji, exc_Ii integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2) integer, allocatable :: idx_sorted_bit(:) @@ -1492,21 +1343,27 @@ END_PROVIDER do i=1,N_det_non_ref idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i enddo + + double precision :: c0(N_states) + do i_state=1,N_states + c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) + enddo + + do i_state = 1, N_states - delta_sub_ij(:,:,:) = 0d0 - delta_sub_ii(:,:) = 0d0 + delta_sub_ij(:,:) = 0d0 provide mo_bielec_integrals_in_map - !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_sub_ij, delta_sub_ii) & + !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_sub_ij) & !$OMP private(i, J, k, degree, degree2, l, deg, ni) & !$OMP private(p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_) & - !$OMP private(ok, phase_Ji, phase_Ik, phase_Ii, contrib2, contrib, delta_IJk, HJk, HIk, HIl, exc_Ik, exc_Ji, exc_Ii) & + !$OMP private(ok, phase_Ji, phase_Ik, phase_Ii, contrib, delta_IJk, HJk, HIk, HIl, exc_Ik, exc_Ji, exc_Ii) & !$OMP private(det_tmp, det_tmp2, II, blok) & !$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & - !$OMP shared(i_state,lambda_mrcc, hf_bitmask, active_sorb) + !$OMP shared(i_state,lambda_mrcc, hf_bitmask, active_sorb,c0) do i=1,N_det_non_ref if(mod(i,1000) == 0) print *, i, "/", N_det_non_ref do J=1,N_det_ref @@ -1553,15 +1410,8 @@ END_PROVIDER call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) if(ok) cycle contrib = delta_IJk * HIl * lambda_mrcc(i_state,l) - if(dabs(psi_ref_coef(II,i_state)).ge.1.d-3) then - contrib2 = contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(l,i_state) - !$OMP ATOMIC - delta_sub_ii(II,i_state) -= contrib2 - else - contrib = contrib * 0.5d0 - endif !$OMP ATOMIC - delta_sub_ij(II, i, i_state) += contrib + delta_sub_ij(i, i_state) += contrib* c0(i_state) * psi_ref_coef(II,i_state) end do end do end do diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index fa486101..b0c3a360 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -402,17 +402,15 @@ end -subroutine mrsc2_dressing_collector(zmq_socket_pull,delta_ii_,delta_ij_,delta_ii_s2_,delta_ij_s2_) +subroutine mrsc2_dressing_collector(zmq_socket_pull,delta_ij_,delta_ij_s2_) use f77_zmq implicit none BEGIN_DOC ! Collects results from the AO integral calculation END_DOC - double precision,intent(inout) :: delta_ij_(N_states,N_det_non_ref,N_det_ref) - double precision,intent(inout) :: delta_ii_(N_states,N_det_ref) - double precision,intent(inout) :: delta_ij_s2_(N_states,N_det_non_ref,N_det_ref) - double precision,intent(inout) :: delta_ii_s2_(N_states,N_det_ref) + double precision,intent(inout) :: delta_ij_(N_states,N_det_non_ref) + double precision,intent(inout) :: delta_ij_s2_(N_states,N_det_non_ref) integer(ZMQ_PTR), intent(in) :: zmq_socket_pull ! integer :: j,l @@ -431,15 +429,18 @@ subroutine mrsc2_dressing_collector(zmq_socket_pull,delta_ii_,delta_ij_,delta_ii integer :: I_i, J, l, i_state, n(2), kk integer,allocatable :: idx(:,:) - delta_ii_(:,:) = 0d0 - delta_ij_(:,:,:) = 0d0 - delta_ii_s2_(:,:) = 0d0 - delta_ij_s2_(:,:,:) = 0d0 + delta_ij_(:,:) = 0d0 + delta_ij_s2_(:,:) = 0d0 zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() allocate ( delta(N_states,0:N_det_non_ref,2), delta_s2(N_states,0:N_det_non_ref,2) ) + double precision :: c0(N_states) + do i_state=1,N_states + c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) + enddo + allocate(idx(N_det_non_ref,2)) more = 1 do while (more == 1) @@ -449,34 +450,19 @@ subroutine mrsc2_dressing_collector(zmq_socket_pull,delta_ii_,delta_ij_,delta_ii do l=1, n(1) do i_state=1,N_states - delta_ij_(i_state,idx(l,1),i_I) += delta(i_state,l,1) - delta_ij_s2_(i_state,idx(l,1),i_I) += delta_s2(i_state,l,1) + delta_ij_(i_state,idx(l,1)) += delta(i_state,l,1) * psi_ref_coef(i_I,i_state) * c0(i_state) + delta_ij_s2_(i_state,idx(l,1)) += delta_s2(i_state,l,1) * psi_ref_coef(i_I,i_state) * c0(i_state) end do end do do l=1, n(2) do i_state=1,N_states - delta_ij_(i_state,idx(l,2),J) += delta(i_state,l,2) - delta_ij_s2_(i_state,idx(l,2),J) += delta_s2(i_state,l,2) + delta_ij_(i_state,idx(l,2)) += delta(i_state,l,2) * psi_ref_coef(J,i_state) * c0(i_state) + delta_ij_s2_(i_state,idx(l,2)) += delta_s2(i_state,l,2) * psi_ref_coef(J,i_state) * c0(i_state) end do end do - if(n(1) /= 0) then - do i_state=1,N_states - delta_ii_(i_state,i_I) += delta(i_state,0,1) - delta_ii_s2_(i_state,i_I) += delta_s2(i_state,0,1) - end do - end if - - if(n(2) /= 0) then - do i_state=1,N_states - delta_ii_(i_state,J) += delta(i_state,0,2) - delta_ii_s2_(i_state,J) += delta_s2(i_state,0,2) - end do - end if - - if (task_id /= 0) then integer, external :: zmq_delete_task if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then @@ -495,10 +481,8 @@ end - BEGIN_PROVIDER [ double precision, delta_ij_old, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_old, (N_states,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ij_s2_old, (N_states,N_det_non_ref,N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_s2_old, (N_states,N_det_ref) ] + BEGIN_PROVIDER [ double precision, delta_ij_old, (N_states,N_det_non_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2_old, (N_states,N_det_non_ref) ] implicit none integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni, m2 @@ -612,11 +596,11 @@ end print *, nzer, ntot, float(nzer) / float(ntot) provide nproc !$OMP PARALLEL DEFAULT(none) & - !$OMP SHARED(delta_ii_old,delta_ij_old,delta_ii_s2_old,delta_ij_s2_old,zmq_socket_pull)& + !$OMP SHARED(delta_ij_old,delta_ij_s2_old,zmq_socket_pull)& !$OMP PRIVATE(i) NUM_THREADS(nproc+1) i = omp_get_thread_num() if (i==0) then - call mrsc2_dressing_collector(zmq_socket_pull,delta_ii_old,delta_ij_old,delta_ii_s2_old,delta_ij_s2_old) + call mrsc2_dressing_collector(zmq_socket_pull,delta_ij_old,delta_ij_s2_old) else call mrsc2_dressing_slave_inproc(i) endif diff --git a/plugins/mrcepa0/mrcepa0_general.irp.f b/plugins/mrcepa0/mrcepa0_general.irp.f index f58008a0..3c390763 100644 --- a/plugins/mrcepa0/mrcepa0_general.irp.f +++ b/plugins/mrcepa0/mrcepa0_general.irp.f @@ -14,8 +14,6 @@ subroutine run(N_st,energy) integer :: n_it_mrcc_max double precision :: thresh_mrcc - double precision, allocatable :: lambda(:) - allocate (lambda(N_states)) thresh_mrcc = thresh_dressed_ci n_it_mrcc_max = n_it_max_dressed_ci @@ -34,7 +32,6 @@ subroutine run(N_st,energy) E_new = 0.d0 delta_E = 1.d0 iteration = 0 - lambda = 1.d0 do while (delta_E > thresh_mrcc) iteration += 1 print *, '===============================================' @@ -45,12 +42,9 @@ subroutine run(N_st,energy) do i=1,N_st call write_double(6,ci_energy_dressed(i),"Energy") enddo - call diagonalize_ci_dressed(lambda) + call diagonalize_ci_dressed E_new = mrcc_e0_denominator(1) !sum(ci_energy_dressed(1:N_states)) -! if (.true.) then -! provide delta_ij_mrcc_pouet -! endif delta_E = (E_new - E_old)/dble(N_states) print *, '' call write_double(6,thresh_mrcc,"thresh_mrcc") diff --git a/plugins/mrcepa0/run_mrcc_slave.irp.f b/plugins/mrcepa0/run_mrcc_slave.irp.f index 3b3cfe44..c2d871e0 100644 --- a/plugins/mrcepa0/run_mrcc_slave.irp.f +++ b/plugins/mrcepa0/run_mrcc_slave.irp.f @@ -35,17 +35,13 @@ subroutine run_mrcc_slave(thread,iproc,energy) integer(bit_kind) :: mask(N_int,2), omask(N_int,2) double precision,allocatable :: delta_ij_loc(:,:,:) - double precision,allocatable :: delta_ii_loc(:,:) !double precision,allocatable :: delta_ij_s2_loc(:,:,:) - !double precision,allocatable :: delta_ii_s2_loc(:,:) integer :: h,p,n logical :: ok double precision :: contrib(N_states) - allocate(delta_ij_loc(N_states,N_det_non_ref,2) & - ,delta_ii_loc(N_states,2))! & + allocate(delta_ij_loc(N_states,N_det_non_ref,2) ) !,delta_ij_s2_loc(N_states,N_det_non_ref,N_det_ref) & - !,delta_ii_s2_loc(N_states, N_det_ref)) allocate(abuf(N_int, 2, N_det_non_ref)) @@ -82,9 +78,7 @@ subroutine run_mrcc_slave(thread,iproc,energy) contrib = 0d0 i_generator = ind(i_i_generator) delta_ij_loc = 0d0 - delta_ii_loc = 0d0 !delta_ij_s2_loc = 0d0 - !delta_ii_s2_loc = 0d0 !call select_connected(i_generator,energy,mrcc_detail(1, i_i_generator),buf,subset) !!!!!!!!!!!!!!!!!!!!!! @@ -103,7 +97,7 @@ subroutine run_mrcc_slave(thread,iproc,energy) n = n - 1 if(n /= 0) then - call mrcc_part_dress_1c(delta_ij_loc(1,1,1), delta_ii_loc(1,1), delta_ij_loc(1,1,2), delta_ii_loc(1,2), & + call mrcc_part_dress_1c(delta_ij_loc(1,1,1), delta_ij_loc(1,1,2), & i_generator,n,abuf,N_int,omask,contrib) endif end do diff --git a/src/Davidson/NEEDED_CHILDREN_MODULES b/src/Davidson/NEEDED_CHILDREN_MODULES index aae89501..9361eccd 100644 --- a/src/Davidson/NEEDED_CHILDREN_MODULES +++ b/src/Davidson/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants +Determinants DavidsonDressed diff --git a/src/Davidson/diagonalize_CI.irp.f b/src/Davidson/diagonalize_CI.irp.f index c65d9763..39edad18 100644 --- a/src/Davidson/diagonalize_CI.irp.f +++ b/src/Davidson/diagonalize_CI.irp.f @@ -65,7 +65,7 @@ END_PROVIDER call davidson_diag_HS2(psi_det,CI_eigenvectors, CI_eigenvectors_s2, & size(CI_eigenvectors,1),CI_electronic_energy, & - N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,6) + N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0) else if (diag_algorithm == "Lapack") then From e44c040434eeaf6d51d18074f64ea194bf0282bf Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 8 Feb 2018 22:16:58 +0100 Subject: [PATCH 13/65] Fixed travis --- .travis.yml | 1 + install/scripts/install_lapack.sh | 6 +++++- {plugins => src}/DavidsonDressed/README.rst | 0 .../DavidsonDressed/diagonalization_hs2_dressed.irp.f | 0 {plugins => src}/DavidsonUndressed/NEEDED_CHILDREN_MODULES | 0 {plugins => src}/DavidsonUndressed/README.rst | 0 {plugins => src}/DavidsonUndressed/davidson_slave.irp.f | 0 .../DavidsonUndressed/diag_restart_save_all_states.irp.f | 0 .../DavidsonUndressed/diag_restart_save_lowest_state.irp.f | 0 .../DavidsonUndressed/diag_restart_save_one_state.irp.f | 0 {plugins => src}/DavidsonUndressed/guess_lowest_state.irp.f | 0 .../DavidsonUndressed/print_H_matrix_restart.irp.f | 0 {plugins => src}/DavidsonUndressed/print_energy.irp.f | 0 13 files changed, 6 insertions(+), 1 deletion(-) rename {plugins => src}/DavidsonDressed/README.rst (100%) rename {plugins => src}/DavidsonDressed/diagonalization_hs2_dressed.irp.f (100%) rename {plugins => src}/DavidsonUndressed/NEEDED_CHILDREN_MODULES (100%) rename {plugins => src}/DavidsonUndressed/README.rst (100%) rename {plugins => src}/DavidsonUndressed/davidson_slave.irp.f (100%) rename {plugins => src}/DavidsonUndressed/diag_restart_save_all_states.irp.f (100%) rename {plugins => src}/DavidsonUndressed/diag_restart_save_lowest_state.irp.f (100%) rename {plugins => src}/DavidsonUndressed/diag_restart_save_one_state.irp.f (100%) rename {plugins => src}/DavidsonUndressed/guess_lowest_state.irp.f (100%) rename {plugins => src}/DavidsonUndressed/print_H_matrix_restart.irp.f (100%) rename {plugins => src}/DavidsonUndressed/print_energy.irp.f (100%) diff --git a/.travis.yml b/.travis.yml index dd28c132..10b19f7f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,6 +24,7 @@ addons: cache: directories: - $HOME/.opam/ + - $HOME/lapack-release language: python python: diff --git a/install/scripts/install_lapack.sh b/install/scripts/install_lapack.sh index 25cbefc6..e23a14d8 100755 --- a/install/scripts/install_lapack.sh +++ b/install/scripts/install_lapack.sh @@ -1,6 +1,10 @@ #!/bin/bash -x -git clone https://github.com/Reference-LAPACK/lapack-release.git +if [[ ! -d lapack-release ]] +then + git clone https://github.com/Reference-LAPACK/lapack-release.git +fi + cd lapack-release cp make.inc.example make.inc make -j 8 diff --git a/plugins/DavidsonDressed/README.rst b/src/DavidsonDressed/README.rst similarity index 100% rename from plugins/DavidsonDressed/README.rst rename to src/DavidsonDressed/README.rst diff --git a/plugins/DavidsonDressed/diagonalization_hs2_dressed.irp.f b/src/DavidsonDressed/diagonalization_hs2_dressed.irp.f similarity index 100% rename from plugins/DavidsonDressed/diagonalization_hs2_dressed.irp.f rename to src/DavidsonDressed/diagonalization_hs2_dressed.irp.f diff --git a/plugins/DavidsonUndressed/NEEDED_CHILDREN_MODULES b/src/DavidsonUndressed/NEEDED_CHILDREN_MODULES similarity index 100% rename from plugins/DavidsonUndressed/NEEDED_CHILDREN_MODULES rename to src/DavidsonUndressed/NEEDED_CHILDREN_MODULES diff --git a/plugins/DavidsonUndressed/README.rst b/src/DavidsonUndressed/README.rst similarity index 100% rename from plugins/DavidsonUndressed/README.rst rename to src/DavidsonUndressed/README.rst diff --git a/plugins/DavidsonUndressed/davidson_slave.irp.f b/src/DavidsonUndressed/davidson_slave.irp.f similarity index 100% rename from plugins/DavidsonUndressed/davidson_slave.irp.f rename to src/DavidsonUndressed/davidson_slave.irp.f diff --git a/plugins/DavidsonUndressed/diag_restart_save_all_states.irp.f b/src/DavidsonUndressed/diag_restart_save_all_states.irp.f similarity index 100% rename from plugins/DavidsonUndressed/diag_restart_save_all_states.irp.f rename to src/DavidsonUndressed/diag_restart_save_all_states.irp.f diff --git a/plugins/DavidsonUndressed/diag_restart_save_lowest_state.irp.f b/src/DavidsonUndressed/diag_restart_save_lowest_state.irp.f similarity index 100% rename from plugins/DavidsonUndressed/diag_restart_save_lowest_state.irp.f rename to src/DavidsonUndressed/diag_restart_save_lowest_state.irp.f diff --git a/plugins/DavidsonUndressed/diag_restart_save_one_state.irp.f b/src/DavidsonUndressed/diag_restart_save_one_state.irp.f similarity index 100% rename from plugins/DavidsonUndressed/diag_restart_save_one_state.irp.f rename to src/DavidsonUndressed/diag_restart_save_one_state.irp.f diff --git a/plugins/DavidsonUndressed/guess_lowest_state.irp.f b/src/DavidsonUndressed/guess_lowest_state.irp.f similarity index 100% rename from plugins/DavidsonUndressed/guess_lowest_state.irp.f rename to src/DavidsonUndressed/guess_lowest_state.irp.f diff --git a/plugins/DavidsonUndressed/print_H_matrix_restart.irp.f b/src/DavidsonUndressed/print_H_matrix_restart.irp.f similarity index 100% rename from plugins/DavidsonUndressed/print_H_matrix_restart.irp.f rename to src/DavidsonUndressed/print_H_matrix_restart.irp.f diff --git a/plugins/DavidsonUndressed/print_energy.irp.f b/src/DavidsonUndressed/print_energy.irp.f similarity index 100% rename from plugins/DavidsonUndressed/print_energy.irp.f rename to src/DavidsonUndressed/print_energy.irp.f From 8e689236be5dada408876da89953dbede6a89894 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 8 Feb 2018 22:22:21 +0100 Subject: [PATCH 14/65] Forgot files --- src/DavidsonDressed/NEEDED_CHILDREN_MODULES | 1 + src/DavidsonDressed/diagonalize_CI.irp.f | 210 ++++++++++++++++++++ 2 files changed, 211 insertions(+) create mode 100644 src/DavidsonDressed/NEEDED_CHILDREN_MODULES create mode 100644 src/DavidsonDressed/diagonalize_CI.irp.f diff --git a/src/DavidsonDressed/NEEDED_CHILDREN_MODULES b/src/DavidsonDressed/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/src/DavidsonDressed/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ + diff --git a/src/DavidsonDressed/diagonalize_CI.irp.f b/src/DavidsonDressed/diagonalize_CI.irp.f new file mode 100644 index 00000000..7b12bc1c --- /dev/null +++ b/src/DavidsonDressed/diagonalize_CI.irp.f @@ -0,0 +1,210 @@ +BEGIN_PROVIDER [ double precision, CI_energy_dressed, (N_states_diag) ] + implicit none + BEGIN_DOC + ! N_states lowest eigenvalues of the CI matrix + END_DOC + + integer :: j + character*(8) :: st + call write_time(6) + do j=1,min(N_det,N_states_diag) + CI_energy_dressed(j) = CI_electronic_energy_dressed(j) + nuclear_repulsion + enddo + do j=1,min(N_det,N_states) + write(st,'(I4)') j + call write_double(6,CI_energy_dressed(j),'Energy of state '//trim(st)) + call write_double(6,CI_eigenvectors_s2_dressed(j),'S^2 of state '//trim(st)) + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ double precision, CI_electronic_energy_dressed, (N_states_diag) ] +&BEGIN_PROVIDER [ double precision, CI_eigenvectors_dressed, (N_det,N_states_diag) ] +&BEGIN_PROVIDER [ double precision, CI_eigenvectors_s2_dressed, (N_states_diag) ] + BEGIN_DOC + ! Eigenvectors/values of the CI matrix + END_DOC + implicit none + double precision :: ovrlp,u_dot_v + integer :: i_good_state + integer, allocatable :: index_good_state_array(:) + logical, allocatable :: good_state_array(:) + double precision, allocatable :: s2_values_tmp(:) + integer :: i_other_state + double precision, allocatable :: eigenvectors(:,:), eigenvectors_s2(:,:), eigenvalues(:) + integer :: i_state + double precision :: e_0 + integer :: i,j,k,mrcc_state + double precision, allocatable :: s2_eigvalues(:) + double precision, allocatable :: e_array(:) + integer, allocatable :: iorder(:) + + PROVIDE threshold_davidson nthreads_davidson + ! Guess values for the "N_states" states of the CI_eigenvectors_dressed + do j=1,min(N_states,N_det) + do i=1,N_det + CI_eigenvectors_dressed(i,j) = psi_coef(i,j) + enddo + enddo + + do j=min(N_states,N_det)+1,N_states_diag + do i=1,N_det + CI_eigenvectors_dressed(i,j) = 0.d0 + enddo + enddo + + if (diag_algorithm == "Davidson") then + + allocate (eigenvectors(size(CI_eigenvectors_dressed,1),size(CI_eigenvectors_dressed,2)),& + eigenvectors_s2(size(CI_eigenvectors_dressed,1),size(CI_eigenvectors_dressed,2)),& + eigenvalues(size(CI_electronic_energy_dressed,1))) + do j=1,min(N_states,N_det) + do i=1,N_det + eigenvectors(i,j) = psi_coef(i,j) + enddo + enddo + do mrcc_state=1,N_states + do j=mrcc_state,min(N_states,N_det) + do i=1,N_det + eigenvectors(i,j) = psi_coef(i,j) + enddo + enddo + call davidson_diag_HS2(psi_det,eigenvectors, eigenvectors_s2, & + size(eigenvectors,1), & + eigenvalues,N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,& + mrcc_state) + CI_eigenvectors_dressed(1:N_det,mrcc_state) = eigenvectors(1:N_det,mrcc_state) + CI_electronic_energy_dressed(mrcc_state) = eigenvalues(mrcc_state) + enddo + do k=N_states+1,N_states_diag + CI_eigenvectors_dressed(1:N_det,k) = eigenvectors(1:N_det,k) + CI_electronic_energy_dressed(k) = eigenvalues(k) + enddo + call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,& + N_states_diag,size(CI_eigenvectors_dressed,1)) + + deallocate (eigenvectors,eigenvalues) + + + else if (diag_algorithm == "Lapack") then + + allocate (eigenvectors(size(H_matrix_dressed,1),N_det)) + allocate (eigenvalues(N_det)) + call lapack_diag(eigenvalues,eigenvectors, & + H_matrix_dressed,size(H_matrix_dressed,1),N_det) + CI_electronic_energy_dressed(:) = 0.d0 + if (s2_eig) then + i_state = 0 + allocate (s2_eigvalues(N_det)) + allocate(index_good_state_array(N_det),good_state_array(N_det)) + good_state_array = .False. + call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int, & + N_det,size(eigenvectors,1)) + do j=1,N_det + ! Select at least n_states states with S^2 values closed to "expected_s2" + if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then + i_state +=1 + index_good_state_array(i_state) = j + good_state_array(j) = .True. + endif + if(i_state.eq.N_states) then + exit + endif + enddo + if(i_state .ne.0)then + ! Fill the first "i_state" states that have a correct S^2 value + do j = 1, i_state + do i=1,N_det + CI_eigenvectors_dressed(i,j) = eigenvectors(i,index_good_state_array(j)) + enddo + CI_electronic_energy_dressed(j) = eigenvalues(index_good_state_array(j)) + CI_eigenvectors_s2_dressed(j) = s2_eigvalues(index_good_state_array(j)) + enddo + i_other_state = 0 + do j = 1, N_det + if(good_state_array(j))cycle + i_other_state +=1 + if(i_state+i_other_state.gt.n_states_diag)then + exit + endif + do i=1,N_det + CI_eigenvectors_dressed(i,i_state+i_other_state) = eigenvectors(i,j) + enddo + CI_electronic_energy_dressed(i_state+i_other_state) = eigenvalues(j) + CI_eigenvectors_s2_dressed(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) + enddo + + else + print*,'' + print*,'!!!!!!!! WARNING !!!!!!!!!' + print*,' Within the ',N_det,'determinants selected' + print*,' and the ',N_states_diag,'states requested' + print*,' We did not find any state with S^2 values close to ',expected_s2 + print*,' We will then set the first N_states eigenvectors of the H matrix' + print*,' as the CI_eigenvectors_dressed' + print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space' + print*,'' + do j=1,min(N_states_diag,N_det) + do i=1,N_det + CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) + enddo + CI_electronic_energy_dressed(j) = eigenvalues(j) + CI_eigenvectors_s2_dressed(j) = s2_eigvalues(j) + enddo + endif + deallocate(index_good_state_array,good_state_array) + deallocate(s2_eigvalues) + else + call u_0_S2_u_0(CI_eigenvectors_s2_dressed,eigenvectors,N_det,psi_det,N_int,& + min(N_det,N_states_diag),size(eigenvectors,1)) + ! Select the "N_states_diag" states of lowest energy + do j=1,min(N_det,N_states_diag) + do i=1,N_det + CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) + enddo + CI_electronic_energy_dressed(j) = eigenvalues(j) + enddo + endif + deallocate(eigenvectors,eigenvalues) + endif + +END_PROVIDER + +subroutine diagonalize_CI_dressed + implicit none + BEGIN_DOC +! Replace the coefficients of the CI states by the coefficients of the +! eigenstates of the CI matrix + END_DOC + integer :: i,j + do j=1,N_states + do i=1,N_det + psi_coef(i,j) = CI_eigenvectors_dressed(i,j) + enddo + enddo + SOFT_TOUCH psi_coef +end + + + +BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ] + implicit none + BEGIN_DOC + ! Dressed H with Delta_ij + END_DOC + integer :: i, j,istate,ii,jj + do istate = 1,N_states + do j=1,N_det + do i=1,N_det + h_matrix_dressed(i,j,istate) = h_matrix_all_dets(i,j) + enddo + enddo + i = dressed_column_idx(istate) + do j = 1, N_det + h_matrix_dressed(i,j,istate) += dressing_column_h(j,istate) + h_matrix_dressed(j,i,istate) += dressing_column_h(j,istate) + enddo + h_matrix_dressed(i,i,istate) -= dressing_column_h(i,istate) + enddo +END_PROVIDER + From 08c2a46f449e958dd0d2f19ac3900995edf7d2cf Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 8 Feb 2018 23:05:17 +0100 Subject: [PATCH 15/65] Fix travis --- install/scripts/install_lapack.sh | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/install/scripts/install_lapack.sh b/install/scripts/install_lapack.sh index e23a14d8..9ea47619 100755 --- a/install/scripts/install_lapack.sh +++ b/install/scripts/install_lapack.sh @@ -1,10 +1,6 @@ #!/bin/bash -x -if [[ ! -d lapack-release ]] -then - git clone https://github.com/Reference-LAPACK/lapack-release.git -fi - +git clone https://github.com/Reference-LAPACK/lapack-release.git || echo "Clone failed" cd lapack-release cp make.inc.example make.inc make -j 8 From d1a1c359f4c1d8075c752990eb2281d7cad1ac5f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 9 Feb 2018 15:55:21 +0100 Subject: [PATCH 16/65] Missing file --- ocaml/qptypes_generator.ml | 18 +++--- plugins/Perturbation/dipole_moment.irp.f | 75 ---------------------- plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES | 2 +- plugins/mrcepa0/dressing_vector.irp.f | 29 +++++++++ 4 files changed, 39 insertions(+), 85 deletions(-) delete mode 100644 plugins/Perturbation/dipole_moment.irp.f create mode 100644 plugins/mrcepa0/dressing_vector.irp.f diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index ba633a60..aa6bd533 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -58,7 +58,7 @@ let input_data = " * Det_number_max : int assert (x > 0) ; - if (x > 10000000000) then + if (x > 10_00_000_000) then warning \"More than 10 billion determinants\"; * States_number : int @@ -142,18 +142,18 @@ let input_data = " let input_ezfio = " * MO_number : int mo_basis_mo_tot_num - 1 : 10000 - More than 10000 MOs + 1 : 10_000 + More than 10_000 MOs * AO_number : int ao_basis_ao_num - 1 : 10000 - More than 10000 AOs + 1 : 10_000 + More than 10_000 AOs * Nucl_number : int nuclei_nucl_num - 1 : 10000 - More than 10000 nuclei + 1 : 10_000 + More than 10_000 nuclei * N_int_number : int determinants_n_int @@ -162,8 +162,8 @@ let input_ezfio = " * Det_number : int determinants_n_det - 1 : 10000000000 - More than 10 billion of determinants + 1 : 10_000_000_000 + More than 10 billion determinants " diff --git a/plugins/Perturbation/dipole_moment.irp.f b/plugins/Perturbation/dipole_moment.irp.f deleted file mode 100644 index 53beb081..00000000 --- a/plugins/Perturbation/dipole_moment.irp.f +++ /dev/null @@ -1,75 +0,0 @@ -subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st,minilist,idx_minilist,N_minilist) - use bitmasks - implicit none - integer, intent(in) :: Nint,ndet,n_st - integer(bit_kind), intent(in) :: det_pert(Nint,2) - double precision , intent(out) :: c_pert(n_st),e_2_pert(n_st),H_pert_diag(N_st) - double precision :: i_O1_psi_array(N_st) - double precision :: i_H_psi_array(N_st) - - integer, intent(in) :: N_minilist - integer, intent(in) :: idx_minilist(0:N_det_selectors) - integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors) - - BEGIN_DOC - ! compute the perturbatibe contribution to the dipole moment of one determinant - ! - ! for the various n_st states, at various level of theory. - ! - ! c_pert(i) = /( - ) - ! - ! e_2_pert(i) = c_pert(i) * - ! - ! H_pert_diag(i) = c_pert(i)^2 * - ! - ! To get the contribution of the first order : - ! - ! = sum(over i) e_2_pert(i) - ! - ! To get the contribution of the diagonal elements of the second order : - ! - ! [ + + sum(over i) H_pert_diag(i) ] / [1. + sum(over i) c_pert(i) **2] - ! - END_DOC - - integer :: i,j - double precision :: diag_H_mat_elem - integer :: exc(0:2,2,2) - integer :: degree - double precision :: phase,delta_e,h,oii,diag_o1_mat_elem - integer :: h1,h2,p1,p2,s1,s2 - ASSERT (Nint == N_int) - ASSERT (Nint > 0) - -! call get_excitation_degree(HF_bitmask,det_pert,degree,N_int) -! if(degree.gt.degree_max_generators+1)then -! H_pert_diag = 0.d0 -! e_2_pert = 0.d0 -! c_pert = 0.d0 -! return -! endif - - call i_O1_psi(mo_dipole_z,det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_O1_psi_array) - !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) - call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) - - h = diag_H_mat_elem(det_pert,Nint) - oii = diag_O1_mat_elem(mo_dipole_z,det_pert,N_int) - - - do i =1,N_st - if(CI_electronic_energy(i)>h.and.CI_electronic_energy(i).ne.0.d0)then - c_pert(i) = -1.d0 - e_2_pert(i) = selection_criterion*selection_criterion_factor*2.d0 - else if (dabs(CI_electronic_energy(i) - h) > 1.d-6) then - c_pert(i) = i_H_psi_array(i) / (CI_electronic_energy(i) - h) - e_2_pert(i) = c_pert(i) * (i_O1_psi_array(i)+i_O1_psi_array(i) ) - H_pert_diag(i) = e_2_pert(i) + c_pert(i) * c_pert(i) * oii - else - c_pert(i) = -1.d0 - e_2_pert(i) = -dabs(i_H_psi_array(i)) - H_pert_diag(i) = c_pert(i) * i_O1_psi_array(i) - endif - enddo -end - diff --git a/plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES b/plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES index 22828878..c11605ac 100644 --- a/plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES +++ b/plugins/Psiref_CAS/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Psiref_Utils DavidsonUndressed +Psiref_Utils diff --git a/plugins/mrcepa0/dressing_vector.irp.f b/plugins/mrcepa0/dressing_vector.irp.f new file mode 100644 index 00000000..7c5809d9 --- /dev/null +++ b/plugins/mrcepa0/dressing_vector.irp.f @@ -0,0 +1,29 @@ + BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ] +&BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] + implicit none + BEGIN_DOC + ! Null dressing vectors + END_DOC + dressing_column_h(:,:) = 0.d0 + dressing_column_s(:,:) = 0.d0 + + integer :: i,ii,k,j,jj, l + double precision :: f, tmp + double precision, external :: u_dot_v + + do k=1,N_states + l = dressed_column_idx(k) + f = 1.d0/psi_coef(l,k) + do jj = 1, n_det_non_ref + j = idx_non_ref(jj) + dressing_column_h(j,k) = delta_ij (k,jj) + dressing_column_s(j,k) = delta_ij_s2(k,jj) + enddo + tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) + dressing_column_h(l,k) -= tmp * f + tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) + dressing_column_s(l,k) -= tmp * f + enddo + +END_PROVIDER + From ea78d114d907ef27156f925b0592a0c08e011c6e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 9 Feb 2018 16:06:57 +0100 Subject: [PATCH 17/65] Fixed double declaration of dressing vector --- plugins/Perturbation/dipole_moment.irp.f | 75 ++++++++++++++++++++++ plugins/Properties/NEEDED_CHILDREN_MODULES | 2 +- 2 files changed, 76 insertions(+), 1 deletion(-) create mode 100644 plugins/Perturbation/dipole_moment.irp.f diff --git a/plugins/Perturbation/dipole_moment.irp.f b/plugins/Perturbation/dipole_moment.irp.f new file mode 100644 index 00000000..0c83436b --- /dev/null +++ b/plugins/Perturbation/dipole_moment.irp.f @@ -0,0 +1,75 @@ +subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st,minilist,idx_minilist,N_minilist) + use bitmasks + implicit none + integer, intent(in) :: Nint,ndet,n_st + integer(bit_kind), intent(in) :: det_pert(Nint,2) + double precision , intent(out) :: c_pert(n_st),e_2_pert(n_st),H_pert_diag(N_st) + double precision :: i_O1_psi_array(N_st) + double precision :: i_H_psi_array(N_st) + + integer, intent(in) :: N_minilist + integer, intent(in) :: idx_minilist(0:N_det_selectors) + integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors) + + BEGIN_DOC + ! compute the perturbative contribution to the dipole moment of one determinant + ! + ! for the various n_st states, at various level of theory. + ! + ! c_pert(i) = /( - ) + ! + ! e_2_pert(i) = c_pert(i) * + ! + ! H_pert_diag(i) = c_pert(i)^2 * + ! + ! To get the contribution of the first order : + ! + ! = sum(over i) e_2_pert(i) + ! + ! To get the contribution of the diagonal elements of the second order : + ! + ! [ + + sum(over i) H_pert_diag(i) ] / [1. + sum(over i) c_pert(i) **2] + ! + END_DOC + + integer :: i,j + double precision :: diag_H_mat_elem + integer :: exc(0:2,2,2) + integer :: degree + double precision :: phase,delta_e,h,oii,diag_o1_mat_elem + integer :: h1,h2,p1,p2,s1,s2 + ASSERT (Nint == N_int) + ASSERT (Nint > 0) + +! call get_excitation_degree(HF_bitmask,det_pert,degree,N_int) +! if(degree.gt.degree_max_generators+1)then +! H_pert_diag = 0.d0 +! e_2_pert = 0.d0 +! c_pert = 0.d0 +! return +! endif + + call i_O1_psi(mo_dipole_z,det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_O1_psi_array) + !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) + call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) + + h = diag_H_mat_elem(det_pert,Nint) + oii = diag_O1_mat_elem(mo_dipole_z,det_pert,N_int) + + + do i =1,N_st + if(CI_electronic_energy(i)>h.and.CI_electronic_energy(i).ne.0.d0)then + c_pert(i) = -1.d0 + e_2_pert(i) = selection_criterion*selection_criterion_factor*2.d0 + else if (dabs(CI_electronic_energy(i) - h) > 1.d-6) then + c_pert(i) = i_H_psi_array(i) / (CI_electronic_energy(i) - h) + e_2_pert(i) = c_pert(i) * (i_O1_psi_array(i)+i_O1_psi_array(i) ) + H_pert_diag(i) = e_2_pert(i) + c_pert(i) * c_pert(i) * oii + else + c_pert(i) = -1.d0 + e_2_pert(i) = -dabs(i_H_psi_array(i)) + H_pert_diag(i) = c_pert(i) * i_O1_psi_array(i) + endif + enddo +end + diff --git a/plugins/Properties/NEEDED_CHILDREN_MODULES b/plugins/Properties/NEEDED_CHILDREN_MODULES index 2a87d1c1..bff2467f 100644 --- a/plugins/Properties/NEEDED_CHILDREN_MODULES +++ b/plugins/Properties/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants DavidsonUndressed +Determinants From ff4938bfde2e09f82b1ff7df683add0b9af46ed8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 9 Feb 2018 16:09:04 +0100 Subject: [PATCH 18/65] FIxed AllSingles --- plugins/All_singles/NEEDED_CHILDREN_MODULES | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/All_singles/NEEDED_CHILDREN_MODULES b/plugins/All_singles/NEEDED_CHILDREN_MODULES index ee0ff040..6f46f9e1 100644 --- a/plugins/All_singles/NEEDED_CHILDREN_MODULES +++ b/plugins/All_singles/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Generators_restart Perturbation Properties Selectors_no_sorted Utils Davidson +Generators_restart Perturbation Properties Selectors_no_sorted Utils DavidsonUndressed From 572639e6323ac3491ca4bb64fa1207294d69ba35 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 9 Feb 2018 17:17:27 +0100 Subject: [PATCH 19/65] Renaming of modules --- plugins/All_singles/NEEDED_CHILDREN_MODULES | 2 +- plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES | 2 +- plugins/CID/NEEDED_CHILDREN_MODULES | 2 +- plugins/CID_selected/NEEDED_CHILDREN_MODULES | 2 +- plugins/CIS/NEEDED_CHILDREN_MODULES | 2 +- plugins/CISD/NEEDED_CHILDREN_MODULES | 2 +- plugins/Casino/NEEDED_CHILDREN_MODULES | 2 +- plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES | 2 +- .../null_dressing_vector.irp.f | 10 - plugins/mrcepa0/NEEDED_CHILDREN_MODULES | 2 +- src/Davidson/NEEDED_CHILDREN_MODULES | 2 +- src/Davidson/README.rst | 320 +---------------- src/Davidson/tree_dependency.png | 0 src/DavidsonDressed/NEEDED_CHILDREN_MODULES | 2 +- .../diagonalization_hs2_dressed.irp.f | 40 --- src/DavidsonUndressed/NEEDED_CHILDREN_MODULES | 1 - src/DavidsonUndressed/README.rst | 14 - src/DavidsonUndressed/davidson_slave.irp.f | 32 -- .../diag_restart_save_all_states.irp.f | 16 - .../diag_restart_save_lowest_state.irp.f | 29 -- .../diag_restart_save_one_state.irp.f | 26 -- .../guess_lowest_state.irp.f | 162 --------- .../print_H_matrix_restart.irp.f | 176 ---------- src/DavidsonUndressed/print_energy.irp.f | 22 -- src/{Davidson => Davidson_Utils}/EZFIO.cfg | 0 src/Davidson_Utils/NEEDED_CHILDREN_MODULES | 1 + src/Davidson_Utils/README.rst | 324 ++++++++++++++++++ .../davidson_parallel.irp.f | 0 .../diagonalization.irp.f | 0 .../diagonalize_CI.irp.f | 0 .../find_reference.irp.f | 0 .../parameters.irp.f | 0 src/{Davidson => Davidson_Utils}/u0Hu0.irp.f | 40 +++ 33 files changed, 382 insertions(+), 853 deletions(-) delete mode 100644 plugins/UndressedMethod/null_dressing_vector.irp.f delete mode 100644 src/Davidson/tree_dependency.png delete mode 100644 src/DavidsonUndressed/NEEDED_CHILDREN_MODULES delete mode 100644 src/DavidsonUndressed/README.rst delete mode 100644 src/DavidsonUndressed/davidson_slave.irp.f delete mode 100644 src/DavidsonUndressed/diag_restart_save_all_states.irp.f delete mode 100644 src/DavidsonUndressed/diag_restart_save_lowest_state.irp.f delete mode 100644 src/DavidsonUndressed/diag_restart_save_one_state.irp.f delete mode 100644 src/DavidsonUndressed/guess_lowest_state.irp.f delete mode 100644 src/DavidsonUndressed/print_H_matrix_restart.irp.f delete mode 100644 src/DavidsonUndressed/print_energy.irp.f rename src/{Davidson => Davidson_Utils}/EZFIO.cfg (100%) create mode 100644 src/Davidson_Utils/NEEDED_CHILDREN_MODULES create mode 100644 src/Davidson_Utils/README.rst rename src/{Davidson => Davidson_Utils}/davidson_parallel.irp.f (100%) rename src/{Davidson => Davidson_Utils}/diagonalization.irp.f (100%) rename src/{Davidson => Davidson_Utils}/diagonalize_CI.irp.f (100%) rename src/{Davidson => Davidson_Utils}/find_reference.irp.f (100%) rename src/{Davidson => Davidson_Utils}/parameters.irp.f (100%) rename src/{Davidson => Davidson_Utils}/u0Hu0.irp.f (92%) diff --git a/plugins/All_singles/NEEDED_CHILDREN_MODULES b/plugins/All_singles/NEEDED_CHILDREN_MODULES index 6f46f9e1..ee0ff040 100644 --- a/plugins/All_singles/NEEDED_CHILDREN_MODULES +++ b/plugins/All_singles/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Generators_restart Perturbation Properties Selectors_no_sorted Utils DavidsonUndressed +Generators_restart Perturbation Properties Selectors_no_sorted Utils Davidson diff --git a/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES b/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES index 91dd3eff..6ff49e64 100644 --- a/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES +++ b/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES @@ -1,2 +1,2 @@ -Generators_CAS Perturbation Selectors_CASSD ZMQ DavidsonUndressed +Generators_CAS Perturbation Selectors_CASSD ZMQ Davidson diff --git a/plugins/CID/NEEDED_CHILDREN_MODULES b/plugins/CID/NEEDED_CHILDREN_MODULES index 3272abe5..1632a44d 100644 --- a/plugins/CID/NEEDED_CHILDREN_MODULES +++ b/plugins/CID/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Selectors_full SingleRefMethod DavidsonUndressed +Selectors_full SingleRefMethod Davidson diff --git a/plugins/CID_selected/NEEDED_CHILDREN_MODULES b/plugins/CID_selected/NEEDED_CHILDREN_MODULES index ea9febd6..6b12c0ee 100644 --- a/plugins/CID_selected/NEEDED_CHILDREN_MODULES +++ b/plugins/CID_selected/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation CID DavidsonUndressed +Perturbation CID Davidson diff --git a/plugins/CIS/NEEDED_CHILDREN_MODULES b/plugins/CIS/NEEDED_CHILDREN_MODULES index 3272abe5..1632a44d 100644 --- a/plugins/CIS/NEEDED_CHILDREN_MODULES +++ b/plugins/CIS/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Selectors_full SingleRefMethod DavidsonUndressed +Selectors_full SingleRefMethod Davidson diff --git a/plugins/CISD/NEEDED_CHILDREN_MODULES b/plugins/CISD/NEEDED_CHILDREN_MODULES index 3272abe5..1632a44d 100644 --- a/plugins/CISD/NEEDED_CHILDREN_MODULES +++ b/plugins/CISD/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Selectors_full SingleRefMethod DavidsonUndressed +Selectors_full SingleRefMethod Davidson diff --git a/plugins/Casino/NEEDED_CHILDREN_MODULES b/plugins/Casino/NEEDED_CHILDREN_MODULES index 2a87d1c1..34de8ddb 100644 --- a/plugins/Casino/NEEDED_CHILDREN_MODULES +++ b/plugins/Casino/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants DavidsonUndressed +Determinants Davidson diff --git a/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES b/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES index cc81a88f..1d6553e8 100644 --- a/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES +++ b/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full Generators_full ZMQ FourIdx MPI DavidsonUndressed +Perturbation Selectors_full Generators_full ZMQ FourIdx MPI Davidson diff --git a/plugins/UndressedMethod/null_dressing_vector.irp.f b/plugins/UndressedMethod/null_dressing_vector.irp.f deleted file mode 100644 index faffe964..00000000 --- a/plugins/UndressedMethod/null_dressing_vector.irp.f +++ /dev/null @@ -1,10 +0,0 @@ - BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ] -&BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] - implicit none - BEGIN_DOC - ! Null dressing vectors - END_DOC - dressing_column_h(:,:) = 0.d0 - dressing_column_s(:,:) = 0.d0 -END_PROVIDER - diff --git a/plugins/mrcepa0/NEEDED_CHILDREN_MODULES b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES index fe8255d1..11d8e8a8 100644 --- a/plugins/mrcepa0/NEEDED_CHILDREN_MODULES +++ b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils ZMQ +Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils ZMQ DavidsonDressed diff --git a/src/Davidson/NEEDED_CHILDREN_MODULES b/src/Davidson/NEEDED_CHILDREN_MODULES index 9361eccd..22a71c5e 100644 --- a/src/Davidson/NEEDED_CHILDREN_MODULES +++ b/src/Davidson/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants DavidsonDressed +Davidson_Utils diff --git a/src/Davidson/README.rst b/src/Davidson/README.rst index 62a7495b..e11d0703 100644 --- a/src/Davidson/README.rst +++ b/src/Davidson/README.rst @@ -1,322 +1,14 @@ +================= +DavidsonUndressed +================= + +Module for main files with undressed Davidson + Needed Modules ============== .. Do not edit this section It was auto-generated .. by the `update_README.py` script. - - -.. image:: tree_dependency.png - -* `Determinants `_ - Documentation ============= .. Do not edit this section It was auto-generated .. by the `update_README.py` script. - - -`ci_eigenvectors `_ - Eigenvectors/values of the CI matrix - - -`ci_eigenvectors_s2 `_ - Eigenvectors/values of the CI matrix - - -`ci_electronic_energy `_ - Eigenvectors/values of the CI matrix - - -`ci_energy `_ - N_states lowest eigenvalues of the CI matrix - - -`davidson_collector `_ - Undocumented - - -`davidson_converged `_ - True if the Davidson algorithm is converged - - -`davidson_criterion `_ - Can be : [ energy | residual | both | wall_time | cpu_time | iterations ] - - -`davidson_diag `_ - Davidson diagonalization. - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - iunit : Unit number for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_diag_hjj `_ - Davidson diagonalization with specific diagonal elements of the H matrix - .br - H_jj : specific diagonal H matrix elements to diagonalize de Davidson - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - N_st_diag : Number of states in which H is diagonalized - .br - iunit : Unit for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_diag_hjj_sjj `_ - Davidson diagonalization with specific diagonal elements of the H matrix - .br - H_jj : specific diagonal H matrix elements to diagonalize de Davidson - .br - S2_out : Output : s^2 - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - N_st_diag : Number of states in which H is diagonalized. Assumed > sze - .br - iunit : Unit for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_diag_hs2 `_ - Davidson diagonalization. - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - iunit : Unit number for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_pull_results `_ - Undocumented - - -`davidson_push_results `_ - Undocumented - - -`davidson_run_slave `_ - Undocumented - - -`davidson_slave `_ - Undocumented - - -`davidson_slave_inproc `_ - Undocumented - - -`davidson_slave_tcp `_ - Undocumented - - -`davidson_slave_work `_ - Undocumented - - -`davidson_sze_max `_ - Number of micro-iterations before re-contracting - - -`det_inf `_ - Ordering function for determinants - - -`diag_and_save `_ - Undocumented - - -`diagonalize_ci `_ - Replace the coefficients of the CI states by the coefficients of the - eigenstates of the CI matrix - - -`disk_based_davidson `_ - If true, disk space is used to store the vectors - - -`distributed_davidson `_ - If true, use the distributed algorithm - - -`find_reference `_ - Undocumented - - -`first_guess `_ - Select all the determinants with the lowest energy as a starting point. - - -`h_s2_u_0_nstates `_ - Computes v_0 = H|u_0> and s_0 = S^2 |u_0> - .br - n : number of determinants - .br - H_jj : array of - .br - S2_jj : array of - - -`h_s2_u_0_nstates_openmp `_ - Computes v_0 = H|u_0> and s_0 = S^2 |u_0> - .br - Assumes that the determinants are in psi_det - .br - istart, iend, ishift, istep are used in ZMQ parallelization. - - -`h_s2_u_0_nstates_openmp_work `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_1 `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_2 `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_3 `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_4 `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_n_int `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_test `_ - Undocumented - - -`h_s2_u_0_nstates_zmq `_ - Computes v_0 = H|u_0> and s_0 = S^2 |u_0> - .br - n : number of determinants - .br - H_jj : array of - .br - S2_jj : array of - - -`h_u_0_nstates `_ - Computes v_0 = H|u_0> - .br - n : number of determinants - .br - H_jj : array of - .br - - -`n_states_diag `_ - Number of states to consider during the Davdison diagonalization - - -`nthreads_davidson `_ - Number of threads for Davdison - - -`print_h_matrix_restart `_ - Undocumented - - -`provide_everything `_ - Undocumented - - -`psi_energy `_ - Energy of the current wave function - - -`routine `_ - Undocumented - - -`sort_dets_ab `_ - Uncodumented : TODO - - -`sort_dets_ab_v `_ - Uncodumented : TODO - - -`sort_dets_ba_v `_ - Uncodumented : TODO - - -`state_following `_ - If true, the states are re-ordered to match the input states - - -`tamiser `_ - Uncodumented : TODO - - -`threshold_davidson `_ - Thresholds of Davidson's algorithm - - -`u_0_h_u_0 `_ - Computes e_0 = / - .br - n : number of determinants - .br - diff --git a/src/Davidson/tree_dependency.png b/src/Davidson/tree_dependency.png deleted file mode 100644 index e69de29b..00000000 diff --git a/src/DavidsonDressed/NEEDED_CHILDREN_MODULES b/src/DavidsonDressed/NEEDED_CHILDREN_MODULES index 8b137891..22a71c5e 100644 --- a/src/DavidsonDressed/NEEDED_CHILDREN_MODULES +++ b/src/DavidsonDressed/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ - +Davidson_Utils diff --git a/src/DavidsonDressed/diagonalization_hs2_dressed.irp.f b/src/DavidsonDressed/diagonalization_hs2_dressed.irp.f index 8a477b5a..297db3c5 100644 --- a/src/DavidsonDressed/diagonalization_hs2_dressed.irp.f +++ b/src/DavidsonDressed/diagonalization_hs2_dressed.irp.f @@ -478,43 +478,3 @@ end -subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze) - use bitmasks - implicit none - BEGIN_DOC - ! Computes e_0 = / - ! - ! n : number of determinants - ! - END_DOC - integer, intent(in) :: n,Nint, N_st, sze - double precision, intent(out) :: e_0(N_st) - double precision, intent(inout) :: u_0(sze,N_st) - integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) - - double precision, allocatable :: v_0(:,:), s_0(:,:), u_1(:,:) - double precision :: u_dot_u,u_dot_v,diag_H_mat_elem - integer :: i,j - - if ((sze > 100000).and.distributed_davidson) then - allocate (v_0(sze,N_states_diag),s_0(sze,N_states_diag), u_1(sze,N_states_diag)) - u_1(1:sze,1:N_states) = u_0(1:sze,1:N_states) - u_1(1:sze,N_states+1:N_states_diag) = 0.d0 - call H_S2_u_0_nstates_zmq(v_0,s_0,u_1,N_states_diag,sze) - deallocate(u_1) - else - allocate (v_0(sze,N_st),s_0(sze,N_st)) - call H_S2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze) - endif - double precision :: norm - do i=1,N_st - norm = u_dot_u(u_0(1,i),n) - if (norm /= 0.d0) then - e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n) - else - e_0(i) = 0.d0 - endif - enddo - deallocate (s_0, v_0) -end - diff --git a/src/DavidsonUndressed/NEEDED_CHILDREN_MODULES b/src/DavidsonUndressed/NEEDED_CHILDREN_MODULES deleted file mode 100644 index 25180044..00000000 --- a/src/DavidsonUndressed/NEEDED_CHILDREN_MODULES +++ /dev/null @@ -1 +0,0 @@ -Davidson UndressedMethod diff --git a/src/DavidsonUndressed/README.rst b/src/DavidsonUndressed/README.rst deleted file mode 100644 index e11d0703..00000000 --- a/src/DavidsonUndressed/README.rst +++ /dev/null @@ -1,14 +0,0 @@ -================= -DavidsonUndressed -================= - -Module for main files with undressed Davidson - -Needed Modules -============== -.. Do not edit this section It was auto-generated -.. by the `update_README.py` script. -Documentation -============= -.. Do not edit this section It was auto-generated -.. by the `update_README.py` script. diff --git a/src/DavidsonUndressed/davidson_slave.irp.f b/src/DavidsonUndressed/davidson_slave.irp.f deleted file mode 100644 index d8143958..00000000 --- a/src/DavidsonUndressed/davidson_slave.irp.f +++ /dev/null @@ -1,32 +0,0 @@ -program davidson_slave - use f77_zmq - implicit none - - - integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - double precision :: energy(N_states_diag) - character*(64) :: state - - call provide_everything - call switch_qp_run_to_master - call omp_set_nested(.True.) - - zmq_context = f77_zmq_ctx_new () - zmq_state = 'davidson' - state = 'Waiting' - - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - do - call wait_for_state(zmq_state,state) - if(trim(state) /= "davidson") exit - integer :: rc, i - print *, 'Davidson slave running' - call davidson_slave_tcp(i) - end do -end - -subroutine provide_everything - PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context ref_bitmask_energy -end subroutine - diff --git a/src/DavidsonUndressed/diag_restart_save_all_states.irp.f b/src/DavidsonUndressed/diag_restart_save_all_states.irp.f deleted file mode 100644 index 3bdc37c5..00000000 --- a/src/DavidsonUndressed/diag_restart_save_all_states.irp.f +++ /dev/null @@ -1,16 +0,0 @@ -program diag_and_save - implicit none - read_wf = .True. - touch read_wf - call routine -end - -subroutine routine - implicit none - call diagonalize_CI - print*,'N_det = ',N_det - call save_wavefunction_general(N_det,N_states_diag,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) - - - -end diff --git a/src/DavidsonUndressed/diag_restart_save_lowest_state.irp.f b/src/DavidsonUndressed/diag_restart_save_lowest_state.irp.f deleted file mode 100644 index 0e379aae..00000000 --- a/src/DavidsonUndressed/diag_restart_save_lowest_state.irp.f +++ /dev/null @@ -1,29 +0,0 @@ -program diag_and_save - implicit none - read_wf = .True. - touch read_wf - call routine -end - -subroutine routine - implicit none - print*,'N_det = ',N_det - PROVIDE H_apply_buffer_allocated - if (s2_eig) then - call make_s2_eigenfunction - endif - call diagonalize_CI - integer :: igood_state - igood_state=1 - double precision, allocatable :: psi_coef_tmp(:) - allocate(psi_coef_tmp(n_det)) - integer :: i - do i = 1, N_det - psi_coef_tmp(i) = psi_coef(i,igood_state) - enddo - call save_wavefunction_general(N_det,1,psi_det,n_det,psi_coef_tmp) - deallocate(psi_coef_tmp) - - - -end diff --git a/src/DavidsonUndressed/diag_restart_save_one_state.irp.f b/src/DavidsonUndressed/diag_restart_save_one_state.irp.f deleted file mode 100644 index c5f4e59d..00000000 --- a/src/DavidsonUndressed/diag_restart_save_one_state.irp.f +++ /dev/null @@ -1,26 +0,0 @@ -program diag_and_save - implicit none - read_wf = .True. - touch read_wf - call routine -end - -subroutine routine - implicit none - print*,'N_det = ',N_det - call diagonalize_CI - write(*,*)'Which state would you like to save ?' - integer :: igood_state - read(5,*)igood_state - double precision, allocatable :: psi_coef_tmp(:) - allocate(psi_coef_tmp(n_det)) - integer :: i - do i = 1, N_det - psi_coef_tmp(i) = psi_coef(i,igood_state) - enddo - call save_wavefunction_general(N_det,1,psi_det,n_det,psi_coef_tmp) - deallocate(psi_coef_tmp) - - - -end diff --git a/src/DavidsonUndressed/guess_lowest_state.irp.f b/src/DavidsonUndressed/guess_lowest_state.irp.f deleted file mode 100644 index f6d0a004..00000000 --- a/src/DavidsonUndressed/guess_lowest_state.irp.f +++ /dev/null @@ -1,162 +0,0 @@ -program first_guess - use bitmasks - implicit none - BEGIN_DOC - ! Select all the determinants with the lowest energy as a starting point. - END_DOC - integer :: i,j - double precision, allocatable :: orb_energy(:) - double precision :: E - integer, allocatable :: kept(:) - integer :: nelec_kept(2) - character :: occ_char, keep_char - - PROVIDE H_apply_buffer_allocated psi_det - allocate (orb_energy(mo_tot_num), kept(0:mo_tot_num)) - nelec_kept(1:2) = 0 - kept(0) = 0 - - print *, 'Orbital energies' - print *, '================' - print *, '' - do i=1,mo_tot_num - keep_char = ' ' - occ_char = '-' - orb_energy(i) = mo_mono_elec_integral(i,i) - do j=1,elec_beta_num - if (i==j) cycle - orb_energy(i) += mo_bielec_integral_jj_anti(i,j) - enddo - do j=1,elec_alpha_num - orb_energy(i) += mo_bielec_integral_jj(i,j) - enddo - if ( (orb_energy(i) > -.5d0).and.(orb_energy(i) < .1d0) ) then - kept(0) += 1 - keep_char = 'X' - kept( kept(0) ) = i - if (i <= elec_beta_num) then - nelec_kept(2) += 1 - endif - if (i <= elec_alpha_num) then - nelec_kept(1) += 1 - endif - endif - if (i <= elec_alpha_num) then - if (i <= elec_beta_num) then - occ_char = '#' - else - occ_char = '+' - endif - endif - print '(I4, 3X, A, 3X, F10.6, 3X, A)', i, occ_char, orb_energy(i), keep_char - enddo - - - integer, allocatable :: list (:,:) - integer(bit_kind), allocatable :: string(:,:) - allocate ( list(N_int*bit_kind_size,2), string(N_int,2) ) - - string = ref_bitmask - call bitstring_to_list( string(1,1), list(1,1), elec_alpha_num, N_int) - call bitstring_to_list( string(1,2), list(1,2), elec_beta_num , N_int) - - psi_det_alpha_unique(:,1) = string(:,1) - psi_det_beta_unique (:,1) = string(:,2) - N_det_alpha_unique = 1 - N_det_beta_unique = 1 - - integer :: i1,i2,i3,i4,i5,i6,i7,i8,i9 - - psi_det_size = kept(0)**(nelec_kept(1)+nelec_kept(2)) - print *, kept(0), nelec_kept(:) - call write_int(6,psi_det_size,'psi_det_size') - TOUCH psi_det_size - -BEGIN_SHELL [ /usr/bin/python ] - -template_alpha_ext = """ -do %(i2)s = %(i1)s-1,1,-1 - list(elec_alpha_num-%(i)d,1) = kept(%(i2)s) - call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int) -""" - -template_alpha = """ -do %(i2)s = %(i1)s-1,1,-1 - list(elec_alpha_num-%(i)d,1) = kept(%(i2)s) - call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int) - N_det_alpha_unique += 1 - psi_det_alpha_unique(:,N_det_alpha_unique) = string(:,1) -""" - -template_beta_ext = """ -do %(i2)s = %(i1)s-1,1,-1 - list(elec_beta_num-%(i)d,2) = kept(%(i2)s) - call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int) -""" -template_beta = """ -do %(i2)s = %(i1)s-1,1,-1 - list(elec_beta_num-%(i)d,2) = kept(%(i2)s) - call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int) - N_det_beta_unique += 1 - psi_det_beta_unique(:,N_det_beta_unique) = string(:,2) -""" - -def write(template_ext,template,imax): - print "case(%d)"%(imax) - def aux(i2,i1,i,j): - if (i==imax-1): - print template%locals() - else: - print template_ext%locals() - i += 1 - j -= 1 - if (i != imax): - i1 = "i%d"%(i) - i2 = "i%d"%(i+1) - aux(i2,i1,i,j) - print "enddo" - - i2 = "i1" - i1 = "kept(0)+1" - i = 0 - aux(i2,i1,i,imax) - -def main(): - print """ - select case (nelec_kept(1)) - case(0) - continue - """ - for imax in range(1,10): - write(template_alpha_ext,template_alpha,imax) - - print """ - end select - - select case (nelec_kept(2)) - case(0) - continue - """ - for imax in range(1,10): - write(template_beta_ext,template_beta,imax) - print "end select" - -main() - -END_SHELL - - TOUCH N_det_alpha_unique N_det_beta_unique psi_det_alpha_unique psi_det_beta_unique - call create_wf_of_psi_bilinear_matrix(.False.) - call diagonalize_ci - j= N_det - do i=1,N_det - if (psi_average_norm_contrib_sorted(i) < 1.d-6) then - j = i-1 - exit - endif -! call debug_det(psi_det_sorted(1,1,i),N_int) - enddo - call save_wavefunction_general(j,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) - - deallocate(orb_energy, kept, list, string) -end diff --git a/src/DavidsonUndressed/print_H_matrix_restart.irp.f b/src/DavidsonUndressed/print_H_matrix_restart.irp.f deleted file mode 100644 index 57fc3633..00000000 --- a/src/DavidsonUndressed/print_H_matrix_restart.irp.f +++ /dev/null @@ -1,176 +0,0 @@ -program print_H_matrix_restart - implicit none - read_wf = .True. - touch read_wf - call routine - -end - -subroutine routine - use bitmasks - implicit none - integer :: i,j - integer, allocatable :: H_matrix_degree(:,:) - double precision, allocatable :: H_matrix_phase(:,:) - integer :: degree - integer(bit_kind), allocatable :: keys_tmp(:,:,:) - allocate(keys_tmp(N_int,2,N_det)) - do i = 1, N_det - print*,'' - call debug_det(psi_det(1,1,i),N_int) - do j = 1, N_int - keys_tmp(j,1,i) = psi_det(j,1,i) - keys_tmp(j,2,i) = psi_det(j,2,i) - enddo - enddo - if(N_det.ge.10000)then - print*,'Warning !!!' - print*,'Number of determinants is ',N_det - print*,'It means that the H matrix will be enormous !' - print*,'stoppping ..' - stop - endif - print*,'' - print*,'Determinants ' - do i = 1, N_det - enddo - allocate(H_matrix_degree(N_det,N_det),H_matrix_phase(N_det,N_det)) - integer :: exc(0:2,2,2) - double precision :: phase - do i = 1, N_det - do j = i, N_det - call get_excitation_degree(psi_det(1,1,i),psi_det(1,1,j),degree,N_int) - H_matrix_degree(i,j) = degree - H_matrix_degree(j,i) = degree - phase = 0.d0 - if(degree==1.or.degree==2)then - call get_excitation(psi_det(1,1,i),psi_det(1,1,j),exc,degree,phase,N_int) - endif - H_matrix_phase(i,j) = phase - H_matrix_phase(j,i) = phase - enddo - enddo - print*,'H matrix ' - double precision :: ref_h_matrix,s2 - ref_h_matrix = H_matrix_all_dets(1,1) - print*,'HF like determinant energy = ',ref_bitmask_energy+nuclear_repulsion - print*,'Ref element of H_matrix = ',ref_h_matrix+nuclear_repulsion - print*,'Printing the H matrix ...' - print*,'' - print*,'' -!do i = 1, N_det -! H_matrix_all_dets(i,i) -= ref_h_matrix -!enddo - - do i = 1, N_det - H_matrix_all_dets(i,i) += nuclear_repulsion - enddo - -!do i = 5,N_det -! H_matrix_all_dets(i,3) = 0.d0 -! H_matrix_all_dets(3,i) = 0.d0 -! H_matrix_all_dets(i,4) = 0.d0 -! H_matrix_all_dets(4,i) = 0.d0 -!enddo - - - - - - do i = 1, N_det - write(*,'(I3,X,A3,1000(F16.7))')i,' | ',H_matrix_all_dets(i,:) - enddo - - print*,'' - print*,'' - print*,'' - print*,'Printing the degree of excitations within the H matrix' - print*,'' - print*,'' - do i = 1, N_det - write(*,'(I3,X,A3,X,1000(I1,X))')i,' | ',H_matrix_degree(i,:) - enddo - - - print*,'' - print*,'' - print*,'Printing the phase of the Hamiltonian matrix elements ' - print*,'' - print*,'' - do i = 1, N_det - write(*,'(I3,X,A3,X,1000(F3.0,X))')i,' | ',H_matrix_phase(i,:) - enddo - print*,'' - - - double precision, allocatable :: eigenvectors(:,:), eigenvalues(:) - double precision, allocatable :: s2_eigvalues(:) - allocate (eigenvectors(size(H_matrix_all_dets,1),N_det)) - allocate (eigenvalues(N_det),s2_eigvalues(N_det)) - call lapack_diag(eigenvalues,eigenvectors, & - H_matrix_all_dets,size(H_matrix_all_dets,1),N_det) - print*,'Two first eigenvectors ' - call u_0_S2_u_0(s2_eigvalues,eigenvectors,n_det,keys_tmp,N_int,N_det,size(eigenvectors,1)) - do j =1, N_states - print*,'s2 = ',s2_eigvalues(j) - print*,'e = ',eigenvalues(j) - print*,'coefs : ' - do i = 1, N_det - print*,'i = ',i,eigenvectors(i,j) - enddo - if(j>1)then - print*,'Delta E(H) = ',eigenvalues(1) - eigenvalues(j) - print*,'Delta E(eV) = ',(eigenvalues(1) - eigenvalues(j))*27.2114d0 - endif - enddo - double precision :: get_mo_bielec_integral,k_a_iv,k_b_iv - integer :: h1,p1,h2,p2 - h1 = 10 - p1 = 16 - h2 = 14 - p2 = 14 -!h1 = 1 -!p1 = 4 -!h2 = 2 -!p2 = 2 - k_a_iv = get_mo_bielec_integral(h1,h2,p2,p1,mo_integrals_map) - h2 = 15 - p2 = 15 - k_b_iv = get_mo_bielec_integral(h1,h2,p2,p1,mo_integrals_map) - print*,'k_a_iv = ',k_a_iv - print*,'k_b_iv = ',k_b_iv - double precision :: k_av,k_bv,k_ai,k_bi - h1 = 16 - p1 = 14 - h2 = 14 - p2 = 16 - k_av = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) - h1 = 16 - p1 = 15 - h2 = 15 - p2 = 16 - k_bv = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) - - h1 = 10 - p1 = 14 - h2 = 14 - p2 = 10 - k_ai = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) - - h1 = 10 - p1 = 15 - h2 = 15 - p2 = 10 - k_bi = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) - - print*,'k_av, k_bv = ',k_av,k_bv - print*,'k_ai, k_bi = ',k_ai,k_bi - double precision :: k_iv - - h1 = 10 - p1 = 16 - h2 = 16 - p2 = 10 - k_iv = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) - print*,'k_iv = ',k_iv -end diff --git a/src/DavidsonUndressed/print_energy.irp.f b/src/DavidsonUndressed/print_energy.irp.f deleted file mode 100644 index ae6f1da2..00000000 --- a/src/DavidsonUndressed/print_energy.irp.f +++ /dev/null @@ -1,22 +0,0 @@ -program print_energy - implicit none - read_wf = .true. - touch read_wf - call routine -end - -subroutine routine - implicit none - integer :: i,j - double precision :: accu,hij - - print*, 'psi_energy = ',psi_energy + nuclear_repulsion - accu = 0.d0 -! do i = 1,N_det -! do j = 1,N_det -! call i_H_j(psi_det(1,1,j),psi_det(1,1,i),N_int,hij) -! accu += psi_coef(i,1) * psi_coef(j,1) * hij -! enddo -! enddo -! print*, 'accu = ',accu + nuclear_repulsion -end diff --git a/src/Davidson/EZFIO.cfg b/src/Davidson_Utils/EZFIO.cfg similarity index 100% rename from src/Davidson/EZFIO.cfg rename to src/Davidson_Utils/EZFIO.cfg diff --git a/src/Davidson_Utils/NEEDED_CHILDREN_MODULES b/src/Davidson_Utils/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..aae89501 --- /dev/null +++ b/src/Davidson_Utils/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ +Determinants diff --git a/src/Davidson_Utils/README.rst b/src/Davidson_Utils/README.rst new file mode 100644 index 00000000..5116f1bc --- /dev/null +++ b/src/Davidson_Utils/README.rst @@ -0,0 +1,324 @@ +Abstract module for Davidson diagonalization. + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. + + +.. image:: tree_dependency.png + +* `Determinants `_ + +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. + + +`ci_eigenvectors `_ + Eigenvectors/values of the CI matrix + + +`ci_eigenvectors_s2 `_ + Eigenvectors/values of the CI matrix + + +`ci_electronic_energy `_ + Eigenvectors/values of the CI matrix + + +`ci_energy `_ + N_states lowest eigenvalues of the CI matrix + + +`davidson_collector `_ + Undocumented + + +`davidson_converged `_ + True if the Davidson algorithm is converged + + +`davidson_criterion `_ + Can be : [ energy | residual | both | wall_time | cpu_time | iterations ] + + +`davidson_diag `_ + Davidson diagonalization. + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + iunit : Unit number for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_hjj `_ + Davidson diagonalization with specific diagonal elements of the H matrix + .br + H_jj : specific diagonal H matrix elements to diagonalize de Davidson + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + N_st_diag : Number of states in which H is diagonalized + .br + iunit : Unit for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_hjj_sjj `_ + Davidson diagonalization with specific diagonal elements of the H matrix + .br + H_jj : specific diagonal H matrix elements to diagonalize de Davidson + .br + S2_out : Output : s^2 + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + N_st_diag : Number of states in which H is diagonalized. Assumed > sze + .br + iunit : Unit for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_hs2 `_ + Davidson diagonalization. + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + iunit : Unit number for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_pull_results `_ + Undocumented + + +`davidson_push_results `_ + Undocumented + + +`davidson_run_slave `_ + Undocumented + + +`davidson_slave `_ + Undocumented + + +`davidson_slave_inproc `_ + Undocumented + + +`davidson_slave_tcp `_ + Undocumented + + +`davidson_slave_work `_ + Undocumented + + +`davidson_sze_max `_ + Number of micro-iterations before re-contracting + + +`det_inf `_ + Ordering function for determinants + + +`diag_and_save `_ + Undocumented + + +`diagonalize_ci `_ + Replace the coefficients of the CI states by the coefficients of the + eigenstates of the CI matrix + + +`disk_based_davidson `_ + If true, disk space is used to store the vectors + + +`distributed_davidson `_ + If true, use the distributed algorithm + + +`find_reference `_ + Undocumented + + +`first_guess `_ + Select all the determinants with the lowest energy as a starting point. + + +`h_s2_u_0_nstates `_ + Computes v_0 = H|u_0> and s_0 = S^2 |u_0> + .br + n : number of determinants + .br + H_jj : array of + .br + S2_jj : array of + + +`h_s2_u_0_nstates_openmp `_ + Computes v_0 = H|u_0> and s_0 = S^2 |u_0> + .br + Assumes that the determinants are in psi_det + .br + istart, iend, ishift, istep are used in ZMQ parallelization. + + +`h_s2_u_0_nstates_openmp_work `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_1 `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_2 `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_3 `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_4 `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_n_int `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_test `_ + Undocumented + + +`h_s2_u_0_nstates_zmq `_ + Computes v_0 = H|u_0> and s_0 = S^2 |u_0> + .br + n : number of determinants + .br + H_jj : array of + .br + S2_jj : array of + + +`h_u_0_nstates `_ + Computes v_0 = H|u_0> + .br + n : number of determinants + .br + H_jj : array of + .br + + +`n_states_diag `_ + Number of states to consider during the Davdison diagonalization + + +`nthreads_davidson `_ + Number of threads for Davdison + + +`print_h_matrix_restart `_ + Undocumented + + +`provide_everything `_ + Undocumented + + +`psi_energy `_ + Energy of the current wave function + + +`routine `_ + Undocumented + + +`sort_dets_ab `_ + Uncodumented : TODO + + +`sort_dets_ab_v `_ + Uncodumented : TODO + + +`sort_dets_ba_v `_ + Uncodumented : TODO + + +`state_following `_ + If true, the states are re-ordered to match the input states + + +`tamiser `_ + Uncodumented : TODO + + +`threshold_davidson `_ + Thresholds of Davidson's algorithm + + +`u_0_h_u_0 `_ + Computes e_0 = / + .br + n : number of determinants + .br + diff --git a/src/Davidson/davidson_parallel.irp.f b/src/Davidson_Utils/davidson_parallel.irp.f similarity index 100% rename from src/Davidson/davidson_parallel.irp.f rename to src/Davidson_Utils/davidson_parallel.irp.f diff --git a/src/Davidson/diagonalization.irp.f b/src/Davidson_Utils/diagonalization.irp.f similarity index 100% rename from src/Davidson/diagonalization.irp.f rename to src/Davidson_Utils/diagonalization.irp.f diff --git a/src/Davidson/diagonalize_CI.irp.f b/src/Davidson_Utils/diagonalize_CI.irp.f similarity index 100% rename from src/Davidson/diagonalize_CI.irp.f rename to src/Davidson_Utils/diagonalize_CI.irp.f diff --git a/src/Davidson/find_reference.irp.f b/src/Davidson_Utils/find_reference.irp.f similarity index 100% rename from src/Davidson/find_reference.irp.f rename to src/Davidson_Utils/find_reference.irp.f diff --git a/src/Davidson/parameters.irp.f b/src/Davidson_Utils/parameters.irp.f similarity index 100% rename from src/Davidson/parameters.irp.f rename to src/Davidson_Utils/parameters.irp.f diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson_Utils/u0Hu0.irp.f similarity index 92% rename from src/Davidson/u0Hu0.irp.f rename to src/Davidson_Utils/u0Hu0.irp.f index e4b1de50..dc020fc9 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson_Utils/u0Hu0.irp.f @@ -458,3 +458,43 @@ N_int;; END_TEMPLATE +subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze) + use bitmasks + implicit none + BEGIN_DOC + ! Computes e_0 = / + ! + ! n : number of determinants + ! + END_DOC + integer, intent(in) :: n,Nint, N_st, sze + double precision, intent(out) :: e_0(N_st) + double precision, intent(inout) :: u_0(sze,N_st) + integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) + + double precision, allocatable :: v_0(:,:), s_0(:,:), u_1(:,:) + double precision :: u_dot_u,u_dot_v,diag_H_mat_elem + integer :: i,j + + if ((sze > 100000).and.distributed_davidson) then + allocate (v_0(sze,N_states_diag),s_0(sze,N_states_diag), u_1(sze,N_states_diag)) + u_1(1:sze,1:N_states) = u_0(1:sze,1:N_states) + u_1(1:sze,N_states+1:N_states_diag) = 0.d0 + call H_S2_u_0_nstates_zmq(v_0,s_0,u_1,N_states_diag,sze) + deallocate(u_1) + else + allocate (v_0(sze,N_st),s_0(sze,N_st)) + call H_S2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze) + endif + double precision :: norm + do i=1,N_st + norm = u_dot_u(u_0(1,i),n) + if (norm /= 0.d0) then + e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n) + else + e_0(i) = 0.d0 + endif + enddo + deallocate (s_0, v_0) +end + From d8b94c0473433c19dd44ecec71f2bb663b560627 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 9 Feb 2018 17:59:50 +0100 Subject: [PATCH 20/65] Fixed travis --- plugins/Properties/NEEDED_CHILDREN_MODULES | 2 +- src/Davidson_Utils/README.rst | 9 ++++++++- .../diagonalization_hs2_dressed.irp.f | 0 3 files changed, 9 insertions(+), 2 deletions(-) rename src/{DavidsonDressed => Davidson_Utils}/diagonalization_hs2_dressed.irp.f (100%) diff --git a/plugins/Properties/NEEDED_CHILDREN_MODULES b/plugins/Properties/NEEDED_CHILDREN_MODULES index bff2467f..320d5dd0 100644 --- a/plugins/Properties/NEEDED_CHILDREN_MODULES +++ b/plugins/Properties/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants +Determinants Davidson diff --git a/src/Davidson_Utils/README.rst b/src/Davidson_Utils/README.rst index 5116f1bc..19499c1f 100644 --- a/src/Davidson_Utils/README.rst +++ b/src/Davidson_Utils/README.rst @@ -1,4 +1,11 @@ -Abstract module for Davidson diagonalization. +Davidson_Utils +============== + +Abstract module for Davidson diagonalization. Contains everything required for the +Davidson algorithm, dressed or not. If a dressing is used, the dressing column should +be defined and the DavidsonDressed module should be used. If no dressing is required, +the Davidson module should be used, and it has a default null dressing vector. + Needed Modules ============== diff --git a/src/DavidsonDressed/diagonalization_hs2_dressed.irp.f b/src/Davidson_Utils/diagonalization_hs2_dressed.irp.f similarity index 100% rename from src/DavidsonDressed/diagonalization_hs2_dressed.irp.f rename to src/Davidson_Utils/diagonalization_hs2_dressed.irp.f From 0f75e345c024087822d69d782199ae0ff6dee655 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 9 Feb 2018 18:23:05 +0100 Subject: [PATCH 21/65] Forgot files --- src/Davidson/davidson_slave.irp.f | 32 ++++ .../diag_restart_save_all_states.irp.f | 16 ++ .../diag_restart_save_lowest_state.irp.f | 29 +++ .../diag_restart_save_one_state.irp.f | 26 +++ src/Davidson/guess_lowest_state.irp.f | 162 ++++++++++++++++ src/Davidson/null_dressing_vector.irp.f | 10 + src/Davidson/print_H_matrix_restart.irp.f | 176 ++++++++++++++++++ src/Davidson/print_energy.irp.f | 22 +++ 8 files changed, 473 insertions(+) create mode 100644 src/Davidson/davidson_slave.irp.f create mode 100644 src/Davidson/diag_restart_save_all_states.irp.f create mode 100644 src/Davidson/diag_restart_save_lowest_state.irp.f create mode 100644 src/Davidson/diag_restart_save_one_state.irp.f create mode 100644 src/Davidson/guess_lowest_state.irp.f create mode 100644 src/Davidson/null_dressing_vector.irp.f create mode 100644 src/Davidson/print_H_matrix_restart.irp.f create mode 100644 src/Davidson/print_energy.irp.f diff --git a/src/Davidson/davidson_slave.irp.f b/src/Davidson/davidson_slave.irp.f new file mode 100644 index 00000000..d8143958 --- /dev/null +++ b/src/Davidson/davidson_slave.irp.f @@ -0,0 +1,32 @@ +program davidson_slave + use f77_zmq + implicit none + + + integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + double precision :: energy(N_states_diag) + character*(64) :: state + + call provide_everything + call switch_qp_run_to_master + call omp_set_nested(.True.) + + zmq_context = f77_zmq_ctx_new () + zmq_state = 'davidson' + state = 'Waiting' + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + do + call wait_for_state(zmq_state,state) + if(trim(state) /= "davidson") exit + integer :: rc, i + print *, 'Davidson slave running' + call davidson_slave_tcp(i) + end do +end + +subroutine provide_everything + PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context ref_bitmask_energy +end subroutine + diff --git a/src/Davidson/diag_restart_save_all_states.irp.f b/src/Davidson/diag_restart_save_all_states.irp.f new file mode 100644 index 00000000..3bdc37c5 --- /dev/null +++ b/src/Davidson/diag_restart_save_all_states.irp.f @@ -0,0 +1,16 @@ +program diag_and_save + implicit none + read_wf = .True. + touch read_wf + call routine +end + +subroutine routine + implicit none + call diagonalize_CI + print*,'N_det = ',N_det + call save_wavefunction_general(N_det,N_states_diag,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) + + + +end diff --git a/src/Davidson/diag_restart_save_lowest_state.irp.f b/src/Davidson/diag_restart_save_lowest_state.irp.f new file mode 100644 index 00000000..0e379aae --- /dev/null +++ b/src/Davidson/diag_restart_save_lowest_state.irp.f @@ -0,0 +1,29 @@ +program diag_and_save + implicit none + read_wf = .True. + touch read_wf + call routine +end + +subroutine routine + implicit none + print*,'N_det = ',N_det + PROVIDE H_apply_buffer_allocated + if (s2_eig) then + call make_s2_eigenfunction + endif + call diagonalize_CI + integer :: igood_state + igood_state=1 + double precision, allocatable :: psi_coef_tmp(:) + allocate(psi_coef_tmp(n_det)) + integer :: i + do i = 1, N_det + psi_coef_tmp(i) = psi_coef(i,igood_state) + enddo + call save_wavefunction_general(N_det,1,psi_det,n_det,psi_coef_tmp) + deallocate(psi_coef_tmp) + + + +end diff --git a/src/Davidson/diag_restart_save_one_state.irp.f b/src/Davidson/diag_restart_save_one_state.irp.f new file mode 100644 index 00000000..c5f4e59d --- /dev/null +++ b/src/Davidson/diag_restart_save_one_state.irp.f @@ -0,0 +1,26 @@ +program diag_and_save + implicit none + read_wf = .True. + touch read_wf + call routine +end + +subroutine routine + implicit none + print*,'N_det = ',N_det + call diagonalize_CI + write(*,*)'Which state would you like to save ?' + integer :: igood_state + read(5,*)igood_state + double precision, allocatable :: psi_coef_tmp(:) + allocate(psi_coef_tmp(n_det)) + integer :: i + do i = 1, N_det + psi_coef_tmp(i) = psi_coef(i,igood_state) + enddo + call save_wavefunction_general(N_det,1,psi_det,n_det,psi_coef_tmp) + deallocate(psi_coef_tmp) + + + +end diff --git a/src/Davidson/guess_lowest_state.irp.f b/src/Davidson/guess_lowest_state.irp.f new file mode 100644 index 00000000..f6d0a004 --- /dev/null +++ b/src/Davidson/guess_lowest_state.irp.f @@ -0,0 +1,162 @@ +program first_guess + use bitmasks + implicit none + BEGIN_DOC + ! Select all the determinants with the lowest energy as a starting point. + END_DOC + integer :: i,j + double precision, allocatable :: orb_energy(:) + double precision :: E + integer, allocatable :: kept(:) + integer :: nelec_kept(2) + character :: occ_char, keep_char + + PROVIDE H_apply_buffer_allocated psi_det + allocate (orb_energy(mo_tot_num), kept(0:mo_tot_num)) + nelec_kept(1:2) = 0 + kept(0) = 0 + + print *, 'Orbital energies' + print *, '================' + print *, '' + do i=1,mo_tot_num + keep_char = ' ' + occ_char = '-' + orb_energy(i) = mo_mono_elec_integral(i,i) + do j=1,elec_beta_num + if (i==j) cycle + orb_energy(i) += mo_bielec_integral_jj_anti(i,j) + enddo + do j=1,elec_alpha_num + orb_energy(i) += mo_bielec_integral_jj(i,j) + enddo + if ( (orb_energy(i) > -.5d0).and.(orb_energy(i) < .1d0) ) then + kept(0) += 1 + keep_char = 'X' + kept( kept(0) ) = i + if (i <= elec_beta_num) then + nelec_kept(2) += 1 + endif + if (i <= elec_alpha_num) then + nelec_kept(1) += 1 + endif + endif + if (i <= elec_alpha_num) then + if (i <= elec_beta_num) then + occ_char = '#' + else + occ_char = '+' + endif + endif + print '(I4, 3X, A, 3X, F10.6, 3X, A)', i, occ_char, orb_energy(i), keep_char + enddo + + + integer, allocatable :: list (:,:) + integer(bit_kind), allocatable :: string(:,:) + allocate ( list(N_int*bit_kind_size,2), string(N_int,2) ) + + string = ref_bitmask + call bitstring_to_list( string(1,1), list(1,1), elec_alpha_num, N_int) + call bitstring_to_list( string(1,2), list(1,2), elec_beta_num , N_int) + + psi_det_alpha_unique(:,1) = string(:,1) + psi_det_beta_unique (:,1) = string(:,2) + N_det_alpha_unique = 1 + N_det_beta_unique = 1 + + integer :: i1,i2,i3,i4,i5,i6,i7,i8,i9 + + psi_det_size = kept(0)**(nelec_kept(1)+nelec_kept(2)) + print *, kept(0), nelec_kept(:) + call write_int(6,psi_det_size,'psi_det_size') + TOUCH psi_det_size + +BEGIN_SHELL [ /usr/bin/python ] + +template_alpha_ext = """ +do %(i2)s = %(i1)s-1,1,-1 + list(elec_alpha_num-%(i)d,1) = kept(%(i2)s) + call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int) +""" + +template_alpha = """ +do %(i2)s = %(i1)s-1,1,-1 + list(elec_alpha_num-%(i)d,1) = kept(%(i2)s) + call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int) + N_det_alpha_unique += 1 + psi_det_alpha_unique(:,N_det_alpha_unique) = string(:,1) +""" + +template_beta_ext = """ +do %(i2)s = %(i1)s-1,1,-1 + list(elec_beta_num-%(i)d,2) = kept(%(i2)s) + call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int) +""" +template_beta = """ +do %(i2)s = %(i1)s-1,1,-1 + list(elec_beta_num-%(i)d,2) = kept(%(i2)s) + call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int) + N_det_beta_unique += 1 + psi_det_beta_unique(:,N_det_beta_unique) = string(:,2) +""" + +def write(template_ext,template,imax): + print "case(%d)"%(imax) + def aux(i2,i1,i,j): + if (i==imax-1): + print template%locals() + else: + print template_ext%locals() + i += 1 + j -= 1 + if (i != imax): + i1 = "i%d"%(i) + i2 = "i%d"%(i+1) + aux(i2,i1,i,j) + print "enddo" + + i2 = "i1" + i1 = "kept(0)+1" + i = 0 + aux(i2,i1,i,imax) + +def main(): + print """ + select case (nelec_kept(1)) + case(0) + continue + """ + for imax in range(1,10): + write(template_alpha_ext,template_alpha,imax) + + print """ + end select + + select case (nelec_kept(2)) + case(0) + continue + """ + for imax in range(1,10): + write(template_beta_ext,template_beta,imax) + print "end select" + +main() + +END_SHELL + + TOUCH N_det_alpha_unique N_det_beta_unique psi_det_alpha_unique psi_det_beta_unique + call create_wf_of_psi_bilinear_matrix(.False.) + call diagonalize_ci + j= N_det + do i=1,N_det + if (psi_average_norm_contrib_sorted(i) < 1.d-6) then + j = i-1 + exit + endif +! call debug_det(psi_det_sorted(1,1,i),N_int) + enddo + call save_wavefunction_general(j,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted) + + deallocate(orb_energy, kept, list, string) +end diff --git a/src/Davidson/null_dressing_vector.irp.f b/src/Davidson/null_dressing_vector.irp.f new file mode 100644 index 00000000..faffe964 --- /dev/null +++ b/src/Davidson/null_dressing_vector.irp.f @@ -0,0 +1,10 @@ + BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ] +&BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] + implicit none + BEGIN_DOC + ! Null dressing vectors + END_DOC + dressing_column_h(:,:) = 0.d0 + dressing_column_s(:,:) = 0.d0 +END_PROVIDER + diff --git a/src/Davidson/print_H_matrix_restart.irp.f b/src/Davidson/print_H_matrix_restart.irp.f new file mode 100644 index 00000000..57fc3633 --- /dev/null +++ b/src/Davidson/print_H_matrix_restart.irp.f @@ -0,0 +1,176 @@ +program print_H_matrix_restart + implicit none + read_wf = .True. + touch read_wf + call routine + +end + +subroutine routine + use bitmasks + implicit none + integer :: i,j + integer, allocatable :: H_matrix_degree(:,:) + double precision, allocatable :: H_matrix_phase(:,:) + integer :: degree + integer(bit_kind), allocatable :: keys_tmp(:,:,:) + allocate(keys_tmp(N_int,2,N_det)) + do i = 1, N_det + print*,'' + call debug_det(psi_det(1,1,i),N_int) + do j = 1, N_int + keys_tmp(j,1,i) = psi_det(j,1,i) + keys_tmp(j,2,i) = psi_det(j,2,i) + enddo + enddo + if(N_det.ge.10000)then + print*,'Warning !!!' + print*,'Number of determinants is ',N_det + print*,'It means that the H matrix will be enormous !' + print*,'stoppping ..' + stop + endif + print*,'' + print*,'Determinants ' + do i = 1, N_det + enddo + allocate(H_matrix_degree(N_det,N_det),H_matrix_phase(N_det,N_det)) + integer :: exc(0:2,2,2) + double precision :: phase + do i = 1, N_det + do j = i, N_det + call get_excitation_degree(psi_det(1,1,i),psi_det(1,1,j),degree,N_int) + H_matrix_degree(i,j) = degree + H_matrix_degree(j,i) = degree + phase = 0.d0 + if(degree==1.or.degree==2)then + call get_excitation(psi_det(1,1,i),psi_det(1,1,j),exc,degree,phase,N_int) + endif + H_matrix_phase(i,j) = phase + H_matrix_phase(j,i) = phase + enddo + enddo + print*,'H matrix ' + double precision :: ref_h_matrix,s2 + ref_h_matrix = H_matrix_all_dets(1,1) + print*,'HF like determinant energy = ',ref_bitmask_energy+nuclear_repulsion + print*,'Ref element of H_matrix = ',ref_h_matrix+nuclear_repulsion + print*,'Printing the H matrix ...' + print*,'' + print*,'' +!do i = 1, N_det +! H_matrix_all_dets(i,i) -= ref_h_matrix +!enddo + + do i = 1, N_det + H_matrix_all_dets(i,i) += nuclear_repulsion + enddo + +!do i = 5,N_det +! H_matrix_all_dets(i,3) = 0.d0 +! H_matrix_all_dets(3,i) = 0.d0 +! H_matrix_all_dets(i,4) = 0.d0 +! H_matrix_all_dets(4,i) = 0.d0 +!enddo + + + + + + do i = 1, N_det + write(*,'(I3,X,A3,1000(F16.7))')i,' | ',H_matrix_all_dets(i,:) + enddo + + print*,'' + print*,'' + print*,'' + print*,'Printing the degree of excitations within the H matrix' + print*,'' + print*,'' + do i = 1, N_det + write(*,'(I3,X,A3,X,1000(I1,X))')i,' | ',H_matrix_degree(i,:) + enddo + + + print*,'' + print*,'' + print*,'Printing the phase of the Hamiltonian matrix elements ' + print*,'' + print*,'' + do i = 1, N_det + write(*,'(I3,X,A3,X,1000(F3.0,X))')i,' | ',H_matrix_phase(i,:) + enddo + print*,'' + + + double precision, allocatable :: eigenvectors(:,:), eigenvalues(:) + double precision, allocatable :: s2_eigvalues(:) + allocate (eigenvectors(size(H_matrix_all_dets,1),N_det)) + allocate (eigenvalues(N_det),s2_eigvalues(N_det)) + call lapack_diag(eigenvalues,eigenvectors, & + H_matrix_all_dets,size(H_matrix_all_dets,1),N_det) + print*,'Two first eigenvectors ' + call u_0_S2_u_0(s2_eigvalues,eigenvectors,n_det,keys_tmp,N_int,N_det,size(eigenvectors,1)) + do j =1, N_states + print*,'s2 = ',s2_eigvalues(j) + print*,'e = ',eigenvalues(j) + print*,'coefs : ' + do i = 1, N_det + print*,'i = ',i,eigenvectors(i,j) + enddo + if(j>1)then + print*,'Delta E(H) = ',eigenvalues(1) - eigenvalues(j) + print*,'Delta E(eV) = ',(eigenvalues(1) - eigenvalues(j))*27.2114d0 + endif + enddo + double precision :: get_mo_bielec_integral,k_a_iv,k_b_iv + integer :: h1,p1,h2,p2 + h1 = 10 + p1 = 16 + h2 = 14 + p2 = 14 +!h1 = 1 +!p1 = 4 +!h2 = 2 +!p2 = 2 + k_a_iv = get_mo_bielec_integral(h1,h2,p2,p1,mo_integrals_map) + h2 = 15 + p2 = 15 + k_b_iv = get_mo_bielec_integral(h1,h2,p2,p1,mo_integrals_map) + print*,'k_a_iv = ',k_a_iv + print*,'k_b_iv = ',k_b_iv + double precision :: k_av,k_bv,k_ai,k_bi + h1 = 16 + p1 = 14 + h2 = 14 + p2 = 16 + k_av = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) + h1 = 16 + p1 = 15 + h2 = 15 + p2 = 16 + k_bv = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) + + h1 = 10 + p1 = 14 + h2 = 14 + p2 = 10 + k_ai = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) + + h1 = 10 + p1 = 15 + h2 = 15 + p2 = 10 + k_bi = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) + + print*,'k_av, k_bv = ',k_av,k_bv + print*,'k_ai, k_bi = ',k_ai,k_bi + double precision :: k_iv + + h1 = 10 + p1 = 16 + h2 = 16 + p2 = 10 + k_iv = get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) + print*,'k_iv = ',k_iv +end diff --git a/src/Davidson/print_energy.irp.f b/src/Davidson/print_energy.irp.f new file mode 100644 index 00000000..ae6f1da2 --- /dev/null +++ b/src/Davidson/print_energy.irp.f @@ -0,0 +1,22 @@ +program print_energy + implicit none + read_wf = .true. + touch read_wf + call routine +end + +subroutine routine + implicit none + integer :: i,j + double precision :: accu,hij + + print*, 'psi_energy = ',psi_energy + nuclear_repulsion + accu = 0.d0 +! do i = 1,N_det +! do j = 1,N_det +! call i_H_j(psi_det(1,1,j),psi_det(1,1,i),N_int,hij) +! accu += psi_coef(i,1) * psi_coef(j,1) * hij +! enddo +! enddo +! print*, 'accu = ',accu + nuclear_repulsion +end From ee538024026a9e8dffb4ee8a7053feb372292b3a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 9 Feb 2018 19:32:04 +0100 Subject: [PATCH 22/65] Moved DavdisonDressed in plugins --- {src => plugins}/DavidsonDressed/NEEDED_CHILDREN_MODULES | 0 {src => plugins}/DavidsonDressed/README.rst | 0 {src => plugins}/DavidsonDressed/diagonalize_CI.irp.f | 0 3 files changed, 0 insertions(+), 0 deletions(-) rename {src => plugins}/DavidsonDressed/NEEDED_CHILDREN_MODULES (100%) rename {src => plugins}/DavidsonDressed/README.rst (100%) rename {src => plugins}/DavidsonDressed/diagonalize_CI.irp.f (100%) diff --git a/src/DavidsonDressed/NEEDED_CHILDREN_MODULES b/plugins/DavidsonDressed/NEEDED_CHILDREN_MODULES similarity index 100% rename from src/DavidsonDressed/NEEDED_CHILDREN_MODULES rename to plugins/DavidsonDressed/NEEDED_CHILDREN_MODULES diff --git a/src/DavidsonDressed/README.rst b/plugins/DavidsonDressed/README.rst similarity index 100% rename from src/DavidsonDressed/README.rst rename to plugins/DavidsonDressed/README.rst diff --git a/src/DavidsonDressed/diagonalize_CI.irp.f b/plugins/DavidsonDressed/diagonalize_CI.irp.f similarity index 100% rename from src/DavidsonDressed/diagonalize_CI.irp.f rename to plugins/DavidsonDressed/diagonalize_CI.irp.f From 66f7019ad14b4f68181ca8e6b4df19400ed539db Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 12 Feb 2018 14:12:25 +0100 Subject: [PATCH 23/65] merge with anthony master --- plugins/dress_zmq/alpha_factory.irp.f | 1138 +++++++++++++++++++++++++ 1 file changed, 1138 insertions(+) create mode 100644 plugins/dress_zmq/alpha_factory.irp.f diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f new file mode 100644 index 00000000..b3738cd3 --- /dev/null +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -0,0 +1,1138 @@ +use bitmasks + + +subroutine assert(cond, msg) + character(*), intent(in) :: msg + logical, intent(in) :: cond + + if(.not. cond) then + print *, "assert failed: "//msg + stop + end if +end subroutine + + +subroutine get_mask_phase(det, phasemask) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: det(N_int, 2) + integer, intent(out) :: phasemask(2,N_int*bit_kind_size) + integer :: s, ni, i + logical :: change + + phasemask = 0_1 + do s=1,2 + change = .false. + do ni=1,N_int + do i=0,bit_kind_size-1 + if(BTEST(det(ni, s), i)) then + change = .not. change + endif + if(change) then + phasemask(s, ishft(ni-1,bit_kind_shift) + i + 1) = 1_1 + endif + end do + end do + end do +end subroutine + + + +subroutine alpha_callback(delta_ij_loc, i_generator, subset) + use bitmasks + implicit none + integer, intent(in) :: i_generator, subset + double precision,intent(inout) :: delta_ij_loc(N_states,N_det_non_ref,2) + + integer :: k,l + + integer(bit_kind) :: hole_mask(N_int,2), particle_mask(N_int,2) + + + do l=1,N_generators_bitmask + call generate_singles_and_doubles(delta_ij_loc, i_generator,l,subset) + enddo +end subroutine + + +subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index, subset) + use bitmasks + implicit none + BEGIN_DOC +! WARNING /!\ : It is assumed that the generators and selectors are psi_det_sorted + END_DOC + + double precision,intent(inout) :: delta_ij_loc(N_states,N_det_non_ref,2) + integer, intent(in) :: i_generator, subset, bitmask_index + + integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii,n + integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2), pmask(N_int, 2) + logical :: fullMatch, ok + + integer(bit_kind) :: mobMask(N_int, 2), negMask(N_int, 2) + integer,allocatable :: preinteresting(:), prefullinteresting(:), interesting(:), fullinteresting(:) + integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) + logical, allocatable :: banned(:,:,:), bannedOrb(:,:) + + double precision, allocatable :: mat(:,:,:) + + logical :: monoAdo, monoBdo + integer :: maskInd + + integer(bit_kind), allocatable:: preinteresting_det(:,:,:) + integer(bit_kind),allocatable :: abuf(:,:,:) + + allocate(abuf(N_int, 2, mo_tot_num**2)) + allocate(preinteresting_det(N_int,2,N_det)) + + PROVIDE fragment_count + + + monoAdo = .true. + monoBdo = .true. + + do k=1,N_int + hole (k,1) = iand(psi_det_generators(k,1,i_generator), generators_bitmask(k,1,s_hole,bitmask_index)) + hole (k,2) = iand(psi_det_generators(k,2,i_generator), generators_bitmask(k,2,s_hole,bitmask_index)) + particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), generators_bitmask(k,1,s_part,bitmask_index)) + particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), generators_bitmask(k,2,s_part,bitmask_index)) + enddo + + integer :: N_holes(2), N_particles(2) + integer :: hole_list(N_int*bit_kind_size,2) + integer :: particle_list(N_int*bit_kind_size,2) + + call bitstring_to_list_ab(hole , hole_list , N_holes , N_int) + call bitstring_to_list_ab(particle, particle_list, N_particles, N_int) + + integer :: l_a, nmax + integer, allocatable :: indices(:), exc_degree(:), iorder(:) + allocate (indices(N_det), & + exc_degree(max(N_det_alpha_unique,N_det_beta_unique))) + + PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique + PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns + PROVIDE psi_bilinear_matrix_transp_order + + k=1 + do i=1,N_det_alpha_unique + call get_excitation_degree_spin(psi_det_alpha_unique(1,i), & + psi_det_generators(1,1,i_generator), exc_degree(i), N_int) + enddo + + do j=1,N_det_beta_unique + call get_excitation_degree_spin(psi_det_beta_unique(1,j), & + psi_det_generators(1,2,i_generator), nt, N_int) + if (nt > 2) cycle + do l_a=psi_bilinear_matrix_columns_loc(j), psi_bilinear_matrix_columns_loc(j+1)-1 + i = psi_bilinear_matrix_rows(l_a) + if (nt + exc_degree(i) <= 4) then + indices(k) = psi_det_sorted_order(psi_bilinear_matrix_order(l_a)) + k=k+1 + endif + enddo + enddo + + do i=1,N_det_beta_unique + call get_excitation_degree_spin(psi_det_beta_unique(1,i), & + psi_det_generators(1,2,i_generator), exc_degree(i), N_int) + enddo + + do j=1,N_det_alpha_unique + call get_excitation_degree_spin(psi_det_alpha_unique(1,j), & + psi_det_generators(1,1,i_generator), nt, N_int) + if (nt > 1) cycle + do l_a=psi_bilinear_matrix_transp_rows_loc(j), psi_bilinear_matrix_transp_rows_loc(j+1)-1 + i = psi_bilinear_matrix_transp_columns(l_a) + if (exc_degree(i) < 3) cycle + if (nt + exc_degree(i) <= 4) then + indices(k) = psi_det_sorted_order( & + psi_bilinear_matrix_order( & + psi_bilinear_matrix_transp_order(l_a))) + k=k+1 + endif + enddo + enddo + nmax=k-1 + + allocate(iorder(nmax)) + do i=1,nmax + iorder(i) = i + enddo + call isort(indices,iorder,nmax) + + allocate(preinteresting(0:N_det_selectors), prefullinteresting(0:N_det), & + interesting(0:N_det_selectors), fullinteresting(0:N_det)) + preinteresting(0) = 0 + prefullinteresting(0) = 0 + + do i=1,N_int + negMask(i,1) = not(psi_det_generators(i,1,i_generator)) + negMask(i,2) = not(psi_det_generators(i,2,i_generator)) + end do + + do k=1,nmax + i = indices(k) + mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i)) + mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,i)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + do j=2,N_int + mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(j,1,i)) + mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i)) + nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + end do + + if(nt <= 4) then + if(i <= N_det_selectors) then + preinteresting(0) += 1 + preinteresting(preinteresting(0)) = i + do j=1,N_int + preinteresting_det(j,1,preinteresting(0)) = psi_det_sorted(j,1,i) + preinteresting_det(j,2,preinteresting(0)) = psi_det_sorted(j,2,i) + enddo + else if(nt <= 2) then + prefullinteresting(0) += 1 + prefullinteresting(prefullinteresting(0)) = i + end if + end if + end do + + + allocate(minilist(N_int, 2, N_det_selectors), fullminilist(N_int, 2, N_det)) + allocate(banned(mo_tot_num, mo_tot_num,2), bannedOrb(mo_tot_num, 2)) + allocate (mat(N_states, mo_tot_num, mo_tot_num)) + maskInd = -1 + integer :: nb_count + do s1=1,2 + do i1=N_holes(s1),1,-1 ! Generate low excitations first + h1 = hole_list(i1,s1) + call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int) + + negMask = not(pmask) + + interesting(0) = 0 + fullinteresting(0) = 0 + + do ii=1,preinteresting(0) + select case (N_int) + case (1) + mobMask(1,1) = iand(negMask(1,1), preinteresting_det(1,1,ii)) + mobMask(1,2) = iand(negMask(1,2), preinteresting_det(1,2,ii)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + case (2) + mobMask(1:2,1) = iand(negMask(1:2,1), preinteresting_det(1:2,1,ii)) + mobMask(1:2,2) = iand(negMask(1:2,2), preinteresting_det(1:2,2,ii)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + & + popcnt(mobMask(2, 1)) + popcnt(mobMask(2, 2)) + case (3) + mobMask(1:3,1) = iand(negMask(1:3,1), preinteresting_det(1:3,1,ii)) + mobMask(1:3,2) = iand(negMask(1:3,2), preinteresting_det(1:3,2,ii)) + nt = 0 + do j=3,1,-1 + if (mobMask(j,1) /= 0_bit_kind) then + nt = nt+ popcnt(mobMask(j, 1)) + if (nt > 4) exit + endif + if (mobMask(j,2) /= 0_bit_kind) then + nt = nt+ popcnt(mobMask(j, 2)) + if (nt > 4) exit + endif + end do + case (4) + mobMask(1:4,1) = iand(negMask(1:4,1), preinteresting_det(1:4,1,ii)) + mobMask(1:4,2) = iand(negMask(1:4,2), preinteresting_det(1:4,2,ii)) + nt = 0 + do j=4,1,-1 + if (mobMask(j,1) /= 0_bit_kind) then + nt = nt+ popcnt(mobMask(j, 1)) + if (nt > 4) exit + endif + if (mobMask(j,2) /= 0_bit_kind) then + nt = nt+ popcnt(mobMask(j, 2)) + if (nt > 4) exit + endif + end do + case default + mobMask(1:N_int,1) = iand(negMask(1:N_int,1), preinteresting_det(1:N_int,1,ii)) + mobMask(1:N_int,2) = iand(negMask(1:N_int,2), preinteresting_det(1:N_int,2,ii)) + nt = 0 + do j=N_int,1,-1 + if (mobMask(j,1) /= 0_bit_kind) then + nt = nt+ popcnt(mobMask(j, 1)) + if (nt > 4) exit + endif + if (mobMask(j,2) /= 0_bit_kind) then + nt = nt+ popcnt(mobMask(j, 2)) + if (nt > 4) exit + endif + end do + end select + + if(nt <= 4) then + i = preinteresting(ii) + interesting(0) += 1 + interesting(interesting(0)) = i + minilist(1,1,interesting(0)) = preinteresting_det(1,1,ii) + minilist(1,2,interesting(0)) = preinteresting_det(1,2,ii) + do j=2,N_int + minilist(j,1,interesting(0)) = preinteresting_det(j,1,ii) + minilist(j,2,interesting(0)) = preinteresting_det(j,2,ii) + enddo + if(nt <= 2) then + fullinteresting(0) += 1 + fullinteresting(fullinteresting(0)) = i + fullminilist(1,1,fullinteresting(0)) = preinteresting_det(1,1,ii) + fullminilist(1,2,fullinteresting(0)) = preinteresting_det(1,2,ii) + do j=2,N_int + fullminilist(j,1,fullinteresting(0)) = preinteresting_det(j,1,ii) + fullminilist(j,2,fullinteresting(0)) = preinteresting_det(j,2,ii) + enddo + end if + end if + + end do + + do ii=1,prefullinteresting(0) + i = prefullinteresting(ii) + nt = 0 + mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i)) + mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,i)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + if (nt > 2) cycle + do j=N_int,2,-1 + mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(j,1,i)) + mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i)) + nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + if (nt > 2) exit + end do + + if(nt <= 2) then + fullinteresting(0) += 1 + fullinteresting(fullinteresting(0)) = i + fullminilist(1,1,fullinteresting(0)) = psi_det_sorted(1,1,i) + fullminilist(1,2,fullinteresting(0)) = psi_det_sorted(1,2,i) + do j=2,N_int + fullminilist(j,1,fullinteresting(0)) = psi_det_sorted(j,1,i) + fullminilist(j,2,fullinteresting(0)) = psi_det_sorted(j,2,i) + enddo + end if + end do + + + + do s2=s1,2 + sp = s1 + + if(s1 /= s2) sp = 3 + + ib = 1 + if(s1 == s2) ib = i1+1 + monoAdo = .true. + do i2=N_holes(s2),ib,-1 ! Generate low excitations first + + h2 = hole_list(i2,s2) + call apply_hole(pmask, s2,h2, mask, ok, N_int) + banned = .false. + do j=1,mo_tot_num + bannedOrb(j, 1) = .true. + bannedOrb(j, 2) = .true. + enddo + do s3=1,2 + do i=1,N_particles(s3) + bannedOrb(particle_list(i,s3), s3) = .false. + enddo + enddo + if(s1 /= s2) then + if(monoBdo) then + bannedOrb(h1,s1) = .false. + end if + if(monoAdo) then + bannedOrb(h2,s2) = .false. + monoAdo = .false. + end if + end if + + maskInd += 1 + if(subset == 0 .or. mod(maskInd, fragment_count) == (subset-1)) then + + call spot_isinwf(mask, fullminilist, i_generator, fullinteresting(0), banned, fullMatch, fullinteresting) + if(fullMatch) cycle + + !call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting) + + call create_alpha_buffer(i_generator, sp, h1, h2, bannedOrb, banned, abuf, n) + + call dress_with_alpha_buffer(delta_ij_loc, minilist, interesting(0), abuf, n) + end if + enddo + if(s1 /= s2) monoBdo = .false. + enddo + enddo + enddo +end subroutine + + +subroutine create_alpha_buffer(i_generator, sp, h1, h2, bannedOrb, banned, abuf, n) + use bitmasks + implicit none + + integer, intent(in) :: i_generator, sp, h1, h2 + logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num) + integer(bit_kind),intent(inout) :: abuf(N_int, 2, *) ! mo_tot_num**2 + integer, intent(out) :: n + logical :: ok + integer :: s1, s2, p1, p2, ib, j, istate + integer(bit_kind) :: mask(N_int, 2), det(N_int, 2) + + n = 0 + + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + + call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int) + + do p1=1,mo_tot_num + if(bannedOrb(p1, s1)) cycle + ib = 1 + if(sp /= 3) ib = p1+1 + do p2=ib,mo_tot_num + if(bannedOrb(p2, s2)) cycle + if(banned(p1,p2)) cycle + n += 1 + call apply_particles(mask, s1, p1, s2, p2, abuf(1,1,n), ok, N_int) + if(.not. ok) stop "error in create_alpha_buffer" + end do + end do +end + + +double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2) + use bitmasks + implicit none + + integer, intent(in) :: phasemask(2,*) + integer, intent(in) :: s1, s2, h1, h2, p1, p2 + logical :: change + integer :: np1 + integer :: np + double precision, save :: res(0:1) = (/1d0, -1d0/) + + np1 = phasemask(s1,h1) + phasemask(s1,p1) + phasemask(s2,h2) + phasemask(s2,p2) + np = np1 + if(p1 < h1) np = np + 1 + if(p2 < h2) np = np + 1 + + if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1 + get_phase_bi = res(iand(np,1)) +end + + +subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer, intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: vect(N_states, mo_tot_num) + integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) + integer :: i, j, h1, h2, p1, p2, sfix, hfix, pfix, hmob, pmob, puti + double precision :: hij + double precision, external :: get_phase_bi, mo_bielec_integral + + integer, parameter :: turn3_2(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + integer, parameter :: turn2(2) = (/2,1/) + + if(h(0,sp) == 2) then + h1 = h(1, sp) + h2 = h(2, sp) + do i=1,3 + puti = p(i, sp) + if(bannedOrb(puti)) cycle + p1 = p(turn3_2(1,i), sp) + p2 = p(turn3_2(2,i), sp) + hij = mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2, p1, h1, h2) + hij *= get_phase_bi(phasemask, sp, sp, h1, p1, h2, p2) + vect(:, puti) += hij * coefs + end do + else if(h(0,sp) == 1) then + sfix = turn2(sp) + hfix = h(1,sfix) + pfix = p(1,sfix) + hmob = h(1,sp) + do j=1,2 + puti = p(j, sp) + if(bannedOrb(puti)) cycle + pmob = p(turn2(j), sp) + hij = mo_bielec_integral(pfix, pmob, hfix, hmob) + hij *= get_phase_bi(phasemask, sp, sfix, hmob, pmob, hfix, pfix) + vect(:, puti) += hij * coefs + end do + else + puti = p(1,sp) + if(.not. bannedOrb(puti)) then + sfix = turn2(sp) + p1 = p(1,sfix) + p2 = p(2,sfix) + h1 = h(1,sfix) + h2 = h(2,sfix) + hij = (mo_bielec_integral(p1,p2,h1,h2) - mo_bielec_integral(p2,p1,h1,h2)) + hij *= get_phase_bi(phasemask, sfix, sfix, h1, p1, h2, p2) + vect(:, puti) += hij * coefs + end if + end if +end + + +subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer, intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: vect(N_states, mo_tot_num) + integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) + integer :: i, hole, p1, p2, sh + logical :: ok + + logical, allocatable :: lbanned(:) + integer(bit_kind) :: det(N_int, 2) + double precision :: hij + double precision, external :: get_phase_bi, mo_bielec_integral + + allocate (lbanned(mo_tot_num)) + lbanned = bannedOrb + sh = 1 + if(h(0,2) == 1) sh = 2 + hole = h(1, sh) + lbanned(p(1,sp)) = .true. + if(p(0,sp) == 2) lbanned(p(2,sp)) = .true. + !print *, "SPm1", sp, sh + + p1 = p(1, sp) + + if(sp == sh) then + p2 = p(2, sp) + lbanned(p2) = .true. + + do i=1,hole-1 + if(lbanned(i)) cycle + hij = (mo_bielec_integral(p1, p2, i, hole) - mo_bielec_integral(p2, p1, i, hole)) + hij *= get_phase_bi(phasemask, sp, sp, i, p1, hole, p2) + vect(1:N_states,i) += hij * coefs(1:N_states) + end do + do i=hole+1,mo_tot_num + if(lbanned(i)) cycle + hij = (mo_bielec_integral(p1, p2, hole, i) - mo_bielec_integral(p2, p1, hole, i)) + hij *= get_phase_bi(phasemask, sp, sp, hole, p1, i, p2) + vect(1:N_states,i) += hij * coefs(1:N_states) + end do + + call apply_particle(mask, sp, p2, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + vect(1:N_states, p2) += hij * coefs(1:N_states) + else + p2 = p(1, sh) + do i=1,mo_tot_num + if(lbanned(i)) cycle + hij = mo_bielec_integral(p1, p2, i, hole) + hij *= get_phase_bi(phasemask, sp, sh, i, p1, hole, p2) + vect(1:N_states,i) += hij * coefs(1:N_states) + end do + end if + + call apply_particle(mask, sp, p1, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + vect(1:N_states, p1) += hij * coefs(1:N_states) +end + + +subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer, intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: vect(N_states, mo_tot_num) + integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) + integer :: i + logical :: ok + + logical, allocatable :: lbanned(:) + integer(bit_kind) :: det(N_int, 2) + double precision :: hij + + allocate(lbanned(mo_tot_num)) + lbanned = bannedOrb + lbanned(p(1,sp)) = .true. + do i=1,mo_tot_num + if(lbanned(i)) cycle + call apply_particle(mask, sp, i, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + vect(1:N_states, i) += hij * coefs(1:N_states) + end do +end + + + + +subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) + use bitmasks + implicit none + + integer, intent(in) :: sp, i_gen, N_sel + integer, intent(in) :: interesting(0:N_sel) + integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) + logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2) + double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + + integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt + integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) + integer :: phasemask(2,N_int*bit_kind_size) + + PROVIDE psi_selectors_coef_transp + mat = 0d0 + + do i=1,N_int + negMask(i,1) = not(mask(i,1)) + negMask(i,2) = not(mask(i,2)) + end do + + do i=1, N_sel ! interesting(0) + !i = interesting(ii) + if (interesting(i) < 0) then + stop 'prefetch interesting(i)' + endif + + + mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) + mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + + if(nt > 4) cycle + + do j=2,N_int + mobMask(j,1) = iand(negMask(j,1), det(j,1,i)) + mobMask(j,2) = iand(negMask(j,2), det(j,2,i)) + nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + end do + + if(nt > 4) cycle + + if (interesting(i) == i_gen) then + if(sp == 3) then + do j=1,mo_tot_num + do k=1,mo_tot_num + banned(j,k,2) = banned(k,j,1) + enddo + enddo + else + do k=1,mo_tot_num + do l=k+1,mo_tot_num + banned(l,k,1) = banned(k,l,1) + end do + end do + end if + end if + + call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) + call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) + + perMask(1,1) = iand(mask(1,1), not(det(1,1,i))) + perMask(1,2) = iand(mask(1,2), not(det(1,2,i))) + do j=2,N_int + perMask(j,1) = iand(mask(j,1), not(det(j,1,i))) + perMask(j,2) = iand(mask(j,2), not(det(j,2,i))) + end do + + call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int) + call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int) + + if (interesting(i) >= i_gen) then + call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask) + if(nt == 4) then + call get_d2(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + else if(nt == 3) then + call get_d1(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + else + call get_d0(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + end if + else + if(nt == 4) call past_d2(banned, p, sp) + if(nt == 3) call past_d1(bannedOrb, p) + end if + end do +end + + +subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer, intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + + double precision, external :: get_phase_bi, mo_bielec_integral + + integer :: i, j, tip, ma, mi, puti, putj + integer :: h1, h2, p1, p2, i1, i2 + double precision :: hij, phase + + integer, parameter:: turn2d(2,3,4) = reshape((/0,0, 0,0, 0,0, 3,4, 0,0, 0,0, 2,4, 1,4, 0,0, 2,3, 1,3, 1,2 /), (/2,3,4/)) + integer, parameter :: turn2(2) = (/2, 1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + + integer :: bant + bant = 1 + + tip = p(0,1) * p(0,2) + + ma = sp + if(p(0,1) > p(0,2)) ma = 1 + if(p(0,1) < p(0,2)) ma = 2 + mi = mod(ma, 2) + 1 + + if(sp == 3) then + if(ma == 2) bant = 2 + + if(tip == 3) then + puti = p(1, mi) + do i = 1, 3 + putj = p(i, ma) + if(banned(putj,puti,bant)) cycle + i1 = turn3(1,i) + i2 = turn3(2,i) + p1 = p(i1, ma) + p2 = p(i2, ma) + h1 = h(1, ma) + h2 = h(2, ma) + + hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) + if(ma == 1) then + mat(:, putj, puti) += coefs(:) * hij + else + mat(:, puti, putj) += coefs(:) * hij + end if + end do + else + h1 = h(1,1) + h2 = h(1,2) + do j = 1,2 + putj = p(j, 2) + p2 = p(turn2(j), 2) + do i = 1,2 + puti = p(i, 1) + + if(banned(puti,putj,bant)) cycle + p1 = p(turn2(i), 1) + + hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) + mat(:, puti, putj) += coefs(:) * hij + end do + end do + end if + + else + if(tip == 0) then + h1 = h(1, ma) + h2 = h(2, ma) + do i=1,3 + puti = p(i, ma) + do j=i+1,4 + putj = p(j, ma) + if(banned(puti,putj,1)) cycle + + i1 = turn2d(1, i, j) + i2 = turn2d(2, i, j) + p1 = p(i1, ma) + p2 = p(i2, ma) + hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) + mat(:, puti, putj) += coefs(:) * hij + end do + end do + else if(tip == 3) then + h1 = h(1, mi) + h2 = h(1, ma) + p1 = p(1, mi) + do i=1,3 + puti = p(turn3(1,i), ma) + putj = p(turn3(2,i), ma) + if(banned(puti,putj,1)) cycle + p2 = p(i, ma) + + hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2) + mat(:, min(puti, putj), max(puti, putj)) += coefs(:) * hij + end do + else ! tip == 4 + puti = p(1, sp) + putj = p(2, sp) + if(.not. banned(puti,putj,1)) then + p1 = p(1, mi) + p2 = p(2, mi) + h1 = h(1, mi) + h2 = h(2, mi) + hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2) + mat(:, puti, putj) += coefs(:) * hij + end if + end if + end if +end + + +subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer,intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) + integer(bit_kind) :: det(N_int, 2) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + double precision :: hij, tmp_row(N_states, mo_tot_num), tmp_row2(N_states, mo_tot_num) + double precision, external :: get_phase_bi, mo_bielec_integral + logical :: ok + + logical, allocatable :: lbanned(:,:) + integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j + integer :: hfix, pfix, h1, h2, p1, p2, ib + + integer, parameter :: turn2(2) = (/2,1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + + integer :: bant + + + allocate (lbanned(mo_tot_num, 2)) + lbanned = bannedOrb + + do i=1, p(0,1) + lbanned(p(i,1), 1) = .true. + end do + do i=1, p(0,2) + lbanned(p(i,2), 2) = .true. + end do + + ma = 1 + if(p(0,2) >= 2) ma = 2 + mi = turn2(ma) + + bant = 1 + + if(sp == 3) then + !move MA + if(ma == 2) bant = 2 + puti = p(1,mi) + hfix = h(1,ma) + p1 = p(1,ma) + p2 = p(2,ma) + if(.not. bannedOrb(puti, mi)) then + tmp_row = 0d0 + do putj=1, hfix-1 + if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle + hij = (mo_bielec_integral(p1, p2, putj, hfix)-mo_bielec_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) + tmp_row(1:N_states,putj) += hij * coefs(1:N_states) + end do + do putj=hfix+1, mo_tot_num + if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle + hij = (mo_bielec_integral(p1, p2, hfix, putj)-mo_bielec_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) + tmp_row(1:N_states,putj) += hij * coefs(1:N_states) + end do + + if(ma == 1) then + mat(1:N_states,1:mo_tot_num,puti) += tmp_row(1:N_states,1:mo_tot_num) + else + mat(1:N_states,puti,1:mo_tot_num) += tmp_row(1:N_states,1:mo_tot_num) + end if + end if + + !MOVE MI + pfix = p(1,mi) + tmp_row = 0d0 + tmp_row2 = 0d0 + do puti=1,mo_tot_num + if(lbanned(puti,mi)) cycle + !p1 fixed + putj = p1 + if(.not. banned(putj,puti,bant)) then + hij = mo_bielec_integral(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix) + tmp_row(:,puti) += hij * coefs(:) + end if + + putj = p2 + if(.not. banned(putj,puti,bant)) then + hij = mo_bielec_integral(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix) + tmp_row2(:,puti) += hij * coefs(:) + end if + end do + + if(mi == 1) then + mat(:,:,p1) += tmp_row(:,:) + mat(:,:,p2) += tmp_row2(:,:) + else + mat(:,p1,:) += tmp_row(:,:) + mat(:,p2,:) += tmp_row2(:,:) + end if + else + if(p(0,ma) == 3) then + do i=1,3 + hfix = h(1,ma) + puti = p(i, ma) + p1 = p(turn3(1,i), ma) + p2 = p(turn3(2,i), ma) + tmp_row = 0d0 + do putj=1,hfix-1 + if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle + hij = (mo_bielec_integral(p1, p2, putj, hfix)-mo_bielec_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) + tmp_row(:,putj) += hij * coefs(:) + end do + do putj=hfix+1,mo_tot_num + if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle + hij = (mo_bielec_integral(p1, p2, hfix, putj)-mo_bielec_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) + tmp_row(:,putj) += hij * coefs(:) + end do + + mat(:, :puti-1, puti) += tmp_row(:,:puti-1) + mat(:, puti, puti:) += tmp_row(:,puti:) + end do + else + hfix = h(1,mi) + pfix = p(1,mi) + p1 = p(1,ma) + p2 = p(2,ma) + tmp_row = 0d0 + tmp_row2 = 0d0 + do puti=1,mo_tot_num + if(lbanned(puti,ma)) cycle + putj = p2 + if(.not. banned(puti,putj,1)) then + hij = mo_bielec_integral(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1) + tmp_row(:,puti) += hij * coefs(:) + end if + + putj = p1 + if(.not. banned(puti,putj,1)) then + hij = mo_bielec_integral(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2) + tmp_row2(:,puti) += hij * coefs(:) + end if + end do + mat(:,:p2-1,p2) += tmp_row(:,:p2-1) + mat(:,p2,p2:) += tmp_row(:,p2:) + mat(:,:p1-1,p1) += tmp_row2(:,:p1-1) + mat(:,p1,p1:) += tmp_row2(:,p1:) + end if + end if + + !! MONO + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + + do i1=1,p(0,s1) + ib = 1 + if(s1 == s2) ib = i1+1 + do i2=ib,p(0,s2) + p1 = p(i1,s1) + p2 = p(i2,s2) + if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle + call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + mat(:, p1, p2) += coefs(:) * hij + end do + end do +end + + +subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer, intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) + integer(bit_kind) :: det(N_int, 2) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + + integer :: i, j, s, h1, h2, p1, p2, puti, putj + double precision :: hij, phase + double precision, external :: get_phase_bi, mo_bielec_integral + logical :: ok + + integer :: bant + bant = 1 + + + if(sp == 3) then ! AB + h1 = p(1,1) + h2 = p(1,2) + do p1=1, mo_tot_num + if(bannedOrb(p1, 1)) cycle + do p2=1, mo_tot_num + if(bannedOrb(p2,2)) cycle + if(banned(p1, p2, bant)) cycle ! rentable? + if(p1 == h1 .or. p2 == h2) then + call apply_particles(mask, 1,p1,2,p2, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + else + phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) + hij = mo_bielec_integral(p1, p2, h1, h2) * phase + end if + mat(:, p1, p2) += coefs(:) * hij + end do + end do + else ! AA BB + p1 = p(1,sp) + p2 = p(2,sp) + do puti=1, mo_tot_num + if(bannedOrb(puti, sp)) cycle + do putj=puti+1, mo_tot_num + if(bannedOrb(putj, sp)) cycle + if(banned(puti, putj, bant)) cycle ! rentable? + if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then + call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + else + hij = (mo_bielec_integral(p1, p2, puti, putj) - mo_bielec_integral(p2, p1, puti, putj))* get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2) + end if + mat(:, puti, putj) += coefs(:) * hij + end do + end do + end if +end + + +subroutine past_d1(bannedOrb, p) + use bitmasks + implicit none + + logical, intent(inout) :: bannedOrb(mo_tot_num, 2) + integer, intent(in) :: p(0:4, 2) + integer :: i,s + + do s = 1, 2 + do i = 1, p(0, s) + bannedOrb(p(i, s), s) = .true. + end do + end do +end + + +subroutine past_d2(banned, p, sp) + use bitmasks + implicit none + + logical, intent(inout) :: banned(mo_tot_num, mo_tot_num) + integer, intent(in) :: p(0:4, 2), sp + integer :: i,j + + if(sp == 3) then + do i=1,p(0,1) + do j=1,p(0,2) + banned(p(i,1), p(j,2)) = .true. + end do + end do + else + do i=1,p(0, sp) + do j=1,i-1 + banned(p(j,sp), p(i,sp)) = .true. + banned(p(i,sp), p(j,sp)) = .true. + end do + end do + end if +end + + +subroutine spot_isinwf(mask, det, i_gen, N, banned, fullMatch, interesting) + use bitmasks + implicit none + + integer, intent(in) :: i_gen, N + integer, intent(in) :: interesting(0:N) + integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N) + logical, intent(inout) :: banned(mo_tot_num, mo_tot_num) + logical, intent(out) :: fullMatch + + + integer :: i, j, na, nb, list(3) + integer(bit_kind) :: myMask(N_int, 2), negMask(N_int, 2) + + fullMatch = .false. + + do i=1,N_int + negMask(i,1) = not(mask(i,1)) + negMask(i,2) = not(mask(i,2)) + end do + + genl : do i=1, N + do j=1, N_int + if(iand(det(j,1,i), mask(j,1)) /= mask(j, 1)) cycle genl + if(iand(det(j,2,i), mask(j,2)) /= mask(j, 2)) cycle genl + end do + + if(interesting(i) < i_gen) then + fullMatch = .true. + return + end if + + do j=1, N_int + myMask(j, 1) = iand(det(j, 1, i), negMask(j, 1)) + myMask(j, 2) = iand(det(j, 2, i), negMask(j, 2)) + end do + + call bitstring_to_list_in_selection(myMask(1,1), list(1), na, N_int) + call bitstring_to_list_in_selection(myMask(1,2), list(na+1), nb, N_int) + banned(list(1), list(2)) = .true. + end do genl +end + + +subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint) + use bitmasks + implicit none + BEGIN_DOC + ! Gives the inidices(+1) of the bits set to 1 in the bit string + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: string(Nint) + integer, intent(out) :: list(Nint*bit_kind_size) + integer, intent(out) :: n_elements + + integer :: i, ishift + integer(bit_kind) :: l + + n_elements = 0 + ishift = 2 + do i=1,Nint + l = string(i) + do while (l /= 0_bit_kind) + n_elements = n_elements+1 + list(n_elements) = ishift+popcnt(l-1_bit_kind) - popcnt(l) + l = iand(l,l-1_bit_kind) + enddo + ishift = ishift + bit_kind_size + enddo + +end From eacc63624c613136a31d7cf6f3cb6999ebe235bd Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 14 Feb 2018 10:33:11 +0100 Subject: [PATCH 24/65] minilisted dress_zmq - mrcc_sto as unittest --- plugins/dress_zmq/alpha_factory.irp.f | 172 ++++++++++++++++++- plugins/dress_zmq/dress_stoch_routines.irp.f | 24 +-- plugins/dress_zmq/dressing.irp.f | 23 +-- plugins/dress_zmq/dressing_vector.irp.f | 29 ++++ plugins/dress_zmq/run_dress_slave.irp.f | 81 ++------- plugins/mrcc_sto/mrcc_dress.irp.f | 37 ++++ plugins/mrcc_sto/mrcc_sto.irp.f | 14 ++ plugins/mrcepa0/NEEDED_CHILDREN_MODULES | 2 +- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 2 +- 9 files changed, 285 insertions(+), 99 deletions(-) create mode 100644 plugins/dress_zmq/dressing_vector.irp.f create mode 100644 plugins/mrcc_sto/mrcc_dress.irp.f create mode 100644 plugins/mrcc_sto/mrcc_sto.irp.f diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index b3738cd3..acd2e3ca 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -43,7 +43,7 @@ subroutine alpha_callback(delta_ij_loc, i_generator, subset) use bitmasks implicit none integer, intent(in) :: i_generator, subset - double precision,intent(inout) :: delta_ij_loc(N_states,N_det_non_ref,2) + double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) integer :: k,l @@ -63,7 +63,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index ! WARNING /!\ : It is assumed that the generators and selectors are psi_det_sorted END_DOC - double precision,intent(inout) :: delta_ij_loc(N_states,N_det_non_ref,2) + double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) integer, intent(in) :: i_generator, subset, bitmask_index integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii,n @@ -587,6 +587,115 @@ end +subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) + use bitmasks + implicit none + + integer, intent(in) :: sp, i_gen, N_sel + integer, intent(in) :: interesting(0:N_sel) + integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) + logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2) + integer, intent(inout) :: mat(mo_tot_num, mo_tot_num) + + integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt + integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) + integer :: phasemask(2,N_int*bit_kind_size) + + PROVIDE psi_selectors_coef_transp + mat = 0 + + do i=1,N_int + negMask(i,1) = not(mask(i,1)) + negMask(i,2) = not(mask(i,2)) + end do + + do i=1, N_sel ! interesting(0) + !i = interesting(ii) + if (interesting(i) < 0) then + stop 'prefetch interesting(i)' + endif + + + mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) + mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + + if(nt > 4) cycle + + do j=2,N_int + mobMask(j,1) = iand(negMask(j,1), det(j,1,i)) + mobMask(j,2) = iand(negMask(j,2), det(j,2,i)) + nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + end do + + if(nt > 4) cycle + + if (interesting(i) == i_gen) then + if(sp == 3) then + do j=1,mo_tot_num + do k=1,mo_tot_num + banned(j,k,2) = banned(k,j,1) + enddo + enddo + else + do k=1,mo_tot_num + do l=k+1,mo_tot_num + banned(l,k,1) = banned(k,l,1) + end do + end do + end if + end if + + call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) + call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) + + perMask(1,1) = iand(mask(1,1), not(det(1,1,i))) + perMask(1,2) = iand(mask(1,2), not(det(1,2,i))) + do j=2,N_int + perMask(j,1) = iand(mask(j,1), not(det(j,1,i))) + perMask(j,2) = iand(mask(j,2), not(det(j,2,i))) + end do + + call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int) + call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int) + + if (interesting(i) >= i_gen) then + call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask) + if(nt == 4) then + call count_d2(mat, p, sp) + else if(nt == 3) then + call count_d1(mat, p, sp) + else + mat(:,:) = mat(:,:) + 1 + end if + else + if(nt == 4) call past_d2(banned, p, sp) + if(nt == 3) call past_d1(bannedOrb, p) + end if + end do + + do i=1,mo_tot_num + do j=1,mo_tot_num + if(banned(i,j,1)) mat(i,j) = 0 + end do + end do + + if(sp == 3) then + do i=1,mo_tot_num + if(bannedOrb(i, 1)) mat(i, :) = 0 + if(bannedOrb(i, 2)) mat(:, i) = 0 + end do + else + do i=1,mo_tot_num + if(bannedOrb(i, sp)) then + mat(:,i) = 0 + mat(i,:) = 0 + end if + end do + end if +end + + subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) use bitmasks @@ -1040,6 +1149,65 @@ subroutine past_d1(bannedOrb, p) end +subroutine count_d1(mat, p, sp) + use bitmasks + implicit none + + integer, intent(inout) :: mat(mo_tot_num, mo_tot_num) + integer, intent(in) :: p(0:4, 2), sp + integer :: i,s,j + + + if(sp == 3) then + do i=1,p(0,1) + mat(p(i,1), :) += 1 + end do + do i=1,p(0,2) + mat(:, p(i,2)) += 1 + end do + + do i=1,p(0,1) + do j=1,p(0,2) + mat(p(i,1), p(j,2)) -= 1 + end do + end do + else + if(sp == 1 .and. p(0,2) /= 0) stop "count_d1 bug" + if(sp == 2 .and. p(0,1) /= 0) stop "count_d1 bug" + do i=1,p(0,sp) + mat(:p(i,sp), p(i,sp)) += 1 + mat(p(i,sp), p(i,sp):) += 1 + mat(p(i,sp), p(i,sp)) -= 1 + end do + end if +end + + +subroutine count_d2(mat, p, sp) + use bitmasks + implicit none + + integer, intent(inout) :: mat(mo_tot_num, mo_tot_num) + integer, intent(in) :: p(0:4, 2), sp + integer :: i,j + + if(sp == 3) then + do i=1,p(0,1) + do j=1,p(0,2) + mat(p(i,1), p(j,2)) += 1 + end do + end do + else + do i=1,p(0, sp) + do j=1,i-1 + mat(p(j,sp), p(i,sp)) += 1 + mat(p(i,sp), p(j,sp)) += 1 + end do + end do + end if +end + + subroutine past_d2(banned, p, sp) use bitmasks implicit none diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index a6f2630a..8dcc6ade 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -15,8 +15,8 @@ subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) integer, external :: omp_get_thread_num double precision, intent(in) :: relative_error, E double precision, intent(out) :: dress(N_states) - double precision, intent(out) :: delta(N_states, N_det_non_ref) - double precision, intent(out) :: delta_s2(N_states, N_det_non_ref) + double precision, intent(out) :: delta(N_states, N_det) + double precision, intent(out) :: delta_s2(N_states, N_det) integer :: i, j, k, Ncp @@ -32,7 +32,7 @@ subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) !!!!!!!!!!!!!!! demander a TOTO !!!!!!! w(:) = 0.d0 w(dress_stoch_istate) = 1.d0 - call update_psi_average_norm_contrib(w) + !call update_psi_average_norm_contrib(w) @@ -135,8 +135,8 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, double precision, intent(out) :: dress(N_states) double precision, allocatable :: cp(:,:,:,:) - double precision, intent(out) :: delta(N_states, N_det_non_ref) - double precision, intent(out) :: delta_s2(N_states, N_det_non_ref) + double precision, intent(out) :: delta(N_states, N_det) + double precision, intent(out) :: delta_s2(N_states, N_det) double precision, allocatable :: delta_loc(:,:,:), delta_det(:,:,:,:) double precision, allocatable :: dress_detail(:,:) double precision :: dress_mwen(N_states) @@ -158,9 +158,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, delta = 0d0 delta_s2 = 0d0 - allocate(delta_det(N_states, N_det_non_ref, 0:comb_teeth+1, 2)) - allocate(cp(N_states, N_det_non_ref, N_cp, 2), dress_detail(N_states, N_det_generators)) - allocate(delta_loc(N_states, N_det_non_ref, 2)) + allocate(delta_det(N_states, N_det, 0:comb_teeth+1, 2)) + allocate(cp(N_states, N_det, N_cp, 2), dress_detail(N_states, N_det)) + allocate(delta_loc(N_states, N_det, 2)) dress_detail = 0d0 delta_det = 0d0 cp = 0d0 @@ -192,8 +192,8 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, loop = .true. pullLoop : do while (loop) - call pull_dress_results(zmq_socket_pull, ind, dress_mwen, delta_loc, task_id) - + call pull_dress_results(zmq_socket_pull, ind, delta_loc, task_id) + dress_mwen(:) = 0d0 !!!!!!!! A CALCULER ICI dress_detail(:, ind) += dress_mwen(:) do j=1,N_cp !! optimizable if(cps(ind, j) > 0d0) then @@ -202,7 +202,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, integer :: toothMwen logical :: fracted fac = cps(ind, j) / cps_N(j) * dress_weight_inv(ind) * comb_step - do k=1,N_det_non_ref + do k=1,N_det do i_state=1,N_states cp(i_state,k,j,1) += delta_loc(i_state,k,1) * fac cp(i_state,k,j,2) += delta_loc(i_state,k,2) * fac @@ -499,7 +499,7 @@ subroutine add_comb(com, computed, cp, N, tbc) implicit none double precision, intent(in) :: com integer, intent(inout) :: N - double precision, intent(inout) :: cp(N_det_non_ref) + double precision, intent(inout) :: cp(N_det) logical, intent(inout) :: computed(N_det_generators) integer, intent(inout) :: tbc(N_det_generators) integer :: i, k, l, dets(comb_teeth) diff --git a/plugins/dress_zmq/dressing.irp.f b/plugins/dress_zmq/dressing.irp.f index c30d9602..1aa9c238 100644 --- a/plugins/dress_zmq/dressing.irp.f +++ b/plugins/dress_zmq/dressing.irp.f @@ -64,10 +64,7 @@ END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det_non_ref, N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii, (N_states, N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ij_s2, (N_states,N_det_non_ref, N_det_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ii_s2, (N_states, N_det_ref) ] + BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ] use bitmasks implicit none @@ -77,18 +74,15 @@ END_PROVIDER double precision :: E_CI_before, relative_error double precision, save :: errr = 0d0 - allocate(dress(N_states), del(N_states, N_det_non_ref), del_s2(N_states, N_det_non_ref)) + allocate(dress(N_states), del(N_states, N_det), del_s2(N_states, N_det)) delta_ij = 0d0 - delta_ii = 0d0 - delta_ij_s2 = 0d0 - delta_ii_s2 = 0d0 E_CI_before = dress_E0_denominator(1) + nuclear_repulsion threshold_selectors = 1.d0 threshold_generators = 1d0 if(errr /= 0d0) then - errr = errr / 2d0 ! + errr = errr / 2d0 else errr = 1d-4 end if @@ -97,11 +91,12 @@ END_PROVIDER call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error)) delta_ij(:,:,1) = del(:,:) - delta_ij_s2(:,:,1) = del_s2(:,:) - do i=N_det_non_ref,1,-1 - delta_ii(dress_stoch_istate,1) -= delta_ij(dress_stoch_istate, i, 1) / psi_ref_coef(1,dress_stoch_istate) * psi_non_ref_coef(i, dress_stoch_istate) - delta_ii_s2(dress_stoch_istate,1) -= delta_ij_s2(dress_stoch_istate, i, 1) / psi_ref_coef(1,dress_stoch_istate) * psi_non_ref_coef(i, dress_stoch_istate) - end do + !delta_ij_s2(:,:,1) = del_s2(:,:) + delta_ij(:,:,2) = del_s2(:,:) + !do i=N_det,1,-1 + ! delta_ii(dress_stoch_istate,1) -= delta_ij(dress_stoch_istate, i, 1) / psi_ref_coef(1,dress_stoch_istate) * psi_coef(i, dress_stoch_istate) + ! delta_ii_s2(dress_stoch_istate,1) -= delta_ij_s2(dress_stoch_istate, i, 1) / psi_ref_coef(1,dress_stoch_istate) * psi_coef(i, dress_stoch_istate) + !end do END_PROVIDER diff --git a/plugins/dress_zmq/dressing_vector.irp.f b/plugins/dress_zmq/dressing_vector.irp.f new file mode 100644 index 00000000..6f5f72ad --- /dev/null +++ b/plugins/dress_zmq/dressing_vector.irp.f @@ -0,0 +1,29 @@ + BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ] +&BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] + implicit none + BEGIN_DOC + ! Null dressing vectors + END_DOC + dressing_column_h(:,:) = 0.d0 + dressing_column_s(:,:) = 0.d0 + + integer :: i,ii,k,j,jj, l + double precision :: f, tmp + double precision, external :: u_dot_v + + do k=1,N_states + l = dressed_column_idx(k) + f = 1.d0/psi_coef(l,k) + do jj = 1, n_det + j = jj !idx_non_ref(jj) + dressing_column_h(j,k) = delta_ij (k,jj,1) + dressing_column_s(j,k) = delta_ij (k,jj,2)!delta_ij_s2(k,jj) + enddo + tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) + dressing_column_h(l,k) -= tmp * f + tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) + dressing_column_s(l,k) -= tmp * f + enddo + +END_PROVIDER + diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index 6f63c96c..b561cec3 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -29,19 +29,11 @@ subroutine run_dress_slave(thread,iproc,energy) double precision,allocatable :: dress_detail(:) integer :: ind - integer(bit_kind),allocatable :: abuf(:,:,:) - integer(bit_kind) :: mask(N_int,2), omask(N_int,2) - double precision,allocatable :: delta_ij_loc(:,:,:) - double precision,allocatable :: delta_ii_loc(:,:) integer :: h,p,n logical :: ok - double precision :: contrib(N_states) - allocate(delta_ij_loc(N_states,N_det_non_ref,2) & - ,delta_ii_loc(N_states,2)) - allocate(abuf(N_int, 2, N_det_non_ref)) - allocate(dress_detail(N_states)) + allocate(delta_ij_loc(N_states,N_det,2)) zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_socket_push = new_zmq_push_socket(thread) @@ -52,47 +44,15 @@ subroutine run_dress_slave(thread,iproc,energy) call end_zmq_push_socket(zmq_socket_push,thread) return end if - dress_detail = 0d0 do call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) if(task_id /= 0) then read (task,*) subset, i_generator - contrib = 0d0 delta_ij_loc = 0d0 - delta_ii_loc = 0d0 - if(do_dress_with_alpha_buffer .or. do_dress_with_alpha) then - do h=1, hh_shortcut(0) - call apply_hole_local(psi_det_generators(1,1,i_generator), hh_exists(1, h), mask, ok, N_int) - if(.not. ok) cycle - omask = 0_bit_kind - if(hh_exists(1, h) /= 0) omask = mask - n = 1 - do p=hh_shortcut(h), hh_shortcut(h+1)-1 - call apply_particle_local(mask, pp_exists(1, p), abuf(1,1,n), ok, N_int) - if(ok) n = n + 1 - if(n > N_det_non_ref) stop "Buffer too small in dress..." - end do - n = n - 1 - - if(n /= 0) then - if(do_dress_with_alpha_buffer) then - call dress_with_alpha_buffer(delta_ij_loc(1,1,1), delta_ii_loc(1,1), delta_ij_loc(1,1,2), delta_ii_loc(1,2), & - i_generator,n,abuf,N_int,omask,contrib) - else - stop 'dress_with_alpha not implemented yet' - end if - endif - end do - else if(do_dress_with_generator) then - stop 'dress_with_generator not implemented yet' - else - stop 'no dressing level defined' - end if - dress_detail(:) = contrib + call alpha_callback(delta_ij_loc, i_generator, subset) call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) - call push_dress_results(zmq_socket_push, i_generator, dress_detail, delta_ij_loc(1,1,1), task_id) - dress_detail(:) = 0d0 + call push_dress_results(zmq_socket_push, i_generator, delta_ij_loc, task_id) else exit end if @@ -103,13 +63,12 @@ subroutine run_dress_slave(thread,iproc,energy) end subroutine -subroutine push_dress_results(zmq_socket_push, ind, dress_detail, delta_loc, task_id) +subroutine push_dress_results(zmq_socket_push, ind, delta_loc, task_id) use f77_zmq implicit none integer(ZMQ_PTR), intent(in) :: zmq_socket_push - double precision, intent(in) :: dress_detail(N_states, N_det_generators) - double precision, intent(in) :: delta_loc(N_states, N_det_non_ref, 2) + double precision, intent(in) :: delta_loc(N_states, N_det, 2) integer, intent(in) :: ind, task_id integer :: rc, i @@ -118,16 +77,9 @@ subroutine push_dress_results(zmq_socket_push, ind, dress_detail, delta_loc, tas if(rc /= 4) stop "push" - rc = f77_zmq_send( zmq_socket_push, dress_detail, 8*N_states, ZMQ_SNDMORE) - if(rc /= 8*N_states) stop "push" - - rc = f77_zmq_send( zmq_socket_push, delta_loc(1,1,1), 8*N_states*N_det_non_ref, ZMQ_SNDMORE) - if(rc /= 8*N_states*N_det_non_ref) stop "push" + rc = f77_zmq_send( zmq_socket_push, delta_loc, 8*N_states*N_det*2, ZMQ_SNDMORE) + if(rc /= 8*N_states*N_det*2) stop "push" - rc = f77_zmq_send( zmq_socket_push, delta_loc(1,1,2), 8*N_states*N_det_non_ref, ZMQ_SNDMORE) - if(rc /= 8*N_states*N_det_non_ref) stop "push" - - rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0) if(rc /= 4) stop "push" @@ -141,30 +93,21 @@ IRP_ENDIF end subroutine -subroutine pull_dress_results(zmq_socket_pull, ind, dress_detail, delta_loc, task_id) +subroutine pull_dress_results(zmq_socket_pull, ind, delta_loc, task_id) use f77_zmq implicit none integer(ZMQ_PTR), intent(in) :: zmq_socket_pull - double precision, intent(inout) :: dress_detail(N_states) - double precision, intent(inout) :: delta_loc(N_states, N_det_non_ref, 2) - double precision, allocatable :: dress_dress_mwen(:,:) + double precision, intent(inout) :: delta_loc(N_states, N_det, 2) integer, intent(out) :: ind integer, intent(out) :: task_id - integer :: rc, rn, i + integer :: rc, i - allocate(dress_dress_mwen(N_states, N_det_non_ref)) rc = f77_zmq_recv( zmq_socket_pull, ind, 4, 0) if(rc /= 4) stop "pull" - rc = f77_zmq_recv( zmq_socket_pull, dress_detail, N_states*8, 0) - if(rc /= 8*N_states) stop "pull" - - rc = f77_zmq_recv( zmq_socket_pull, delta_loc(1,1,1), N_states*8*N_det_non_ref, 0) - if(rc /= 8*N_states*N_det_non_ref) stop "pull" - - rc = f77_zmq_recv( zmq_socket_pull, delta_loc(1,1,2), N_states*8*N_det_non_ref, 0) - if(rc /= 8*N_states*N_det_non_ref) stop "pull" + rc = f77_zmq_recv( zmq_socket_pull, delta_loc, N_states*8*N_det*2, 0) + if(rc /= 8*N_states*N_det*2) stop "pull" rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0) if(rc /= 4) stop "pull" diff --git a/plugins/mrcc_sto/mrcc_dress.irp.f b/plugins/mrcc_sto/mrcc_dress.irp.f new file mode 100644 index 00000000..f51f5992 --- /dev/null +++ b/plugins/mrcc_sto/mrcc_dress.irp.f @@ -0,0 +1,37 @@ + +! BEGIN_PROVIDER [ logical, do_dress_with_alpha ] +!&BEGIN_PROVIDER [ logical, do_dress_with_alpha_buffer ] +!&BEGIN_PROVIDER [ logical, do_dress_with_generator ] +! implicit none +! do_dress_with_alpha = .false. +! do_dress_with_alpha_buffer = .true. +! do_dress_with_generator = .false. +!END_PROVIDER + +subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, abuf, n_abuf) + use bitmasks + implicit none + double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) + integer, intent(in) :: n_minilist, n_abuf + integer(bit_kind),intent(in) :: abuf(N_int, 2, n_abuf), minilist(N_int, 2, n_minilist) + integer :: a, i, nref, nobt, deg + + do a=1,n_abuf + nref=0 + do i=1,N_det + call get_excitation_degree(psi_det(1,1,i), abuf(1,1,a), deg, N_int) + if(deg <= 2) nref = nref + 1 + end do + nobt=0 + do i=1,n_minilist + call get_excitation_degree(minilist(1,1,i), abuf(1,1,a), deg, N_int) + if(deg <= 2) nobt = nobt + 1 + end do + + if(nref /= nobt) stop "foireous minilist" + end do + + delta_ij_loc = 1d0 +end subroutine + + diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f new file mode 100644 index 00000000..205c480b --- /dev/null +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -0,0 +1,14 @@ +program mrcc_sto + implicit none + BEGIN_DOC +! TODO + END_DOC + print *, "!!!!!!========================!!!!!!" + print *, "!!!!!!========================!!!!!!" + print *, "!!!!!!========================!!!!!!" + print *, "MRCC_STO not implemented - acts as a unittest for dress_zmq" + print *, "!!!!!!========================!!!!!!" + print *, "!!!!!!========================!!!!!!" + print *, "!!!!!!========================!!!!!!" + call dress_zmq() +end diff --git a/plugins/mrcepa0/NEEDED_CHILDREN_MODULES b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES index 11d8e8a8..79f56893 100644 --- a/plugins/mrcepa0/NEEDED_CHILDREN_MODULES +++ b/plugins/mrcepa0/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils ZMQ DavidsonDressed +DavidsonDressed Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils ZMQ diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index 571688ac..cdda311b 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -44,7 +44,7 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) w = 0.d0 w = 1.d0 - call update_psi_average_norm_contrib(w) + !call update_psi_average_norm_contrib(w) From 9e317da0cb5805027347225994625d9b31c9a384 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 14 Feb 2018 15:21:08 +0100 Subject: [PATCH 25/65] init alpha_factory - mrcc_sto working countdown --- plugins/dress_zmq/alpha_factory.irp.f | 754 +++++++++++--------------- plugins/mrcc_sto/mrcc_sto.irp.f | 12 +- 2 files changed, 326 insertions(+), 440 deletions(-) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index acd2e3ca..cd9df4be 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -1,16 +1,6 @@ use bitmasks -subroutine assert(cond, msg) - character(*), intent(in) :: msg - logical, intent(in) :: cond - - if(.not. cond) then - print *, "assert failed: "//msg - stop - end if -end subroutine - subroutine get_mask_phase(det, phasemask) use bitmasks @@ -74,6 +64,8 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index integer,allocatable :: preinteresting(:), prefullinteresting(:), interesting(:), fullinteresting(:) integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) logical, allocatable :: banned(:,:,:), bannedOrb(:,:) + integer, allocatable :: counted(:,:), countedOrb(:,:) + integer :: countedGlob double precision, allocatable :: mat(:,:,:) @@ -85,7 +77,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index allocate(abuf(N_int, 2, mo_tot_num**2)) allocate(preinteresting_det(N_int,2,N_det)) - + PROVIDE fragment_count @@ -202,6 +194,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index allocate(minilist(N_int, 2, N_det_selectors), fullminilist(N_int, 2, N_det)) allocate(banned(mo_tot_num, mo_tot_num,2), bannedOrb(mo_tot_num, 2)) + allocate(counted(mo_tot_num, mo_tot_num), countedOrb(mo_tot_num, 2)) allocate (mat(N_states, mo_tot_num, mo_tot_num)) maskInd = -1 integer :: nb_count @@ -360,11 +353,11 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index call spot_isinwf(mask, fullminilist, i_generator, fullinteresting(0), banned, fullMatch, fullinteresting) if(fullMatch) cycle - !call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting) + call count_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, countedGlob, countedOrb, counted, interesting) + call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, countedGlob, countedOrb, counted, interesting) + !call create_alpha_buffer(i_generator, sp, h1, h2, bannedOrb, banned, abuf, n) - call create_alpha_buffer(i_generator, sp, h1, h2, bannedOrb, banned, abuf, n) - - call dress_with_alpha_buffer(delta_ij_loc, minilist, interesting(0), abuf, n) + !call dress_with_alpha_buffer(delta_ij_loc, minilist, interesting(0), abuf, n) end if enddo if(s1 /= s2) monoBdo = .false. @@ -374,220 +367,9 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index end subroutine -subroutine create_alpha_buffer(i_generator, sp, h1, h2, bannedOrb, banned, abuf, n) - use bitmasks - implicit none - - integer, intent(in) :: i_generator, sp, h1, h2 - logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num) - integer(bit_kind),intent(inout) :: abuf(N_int, 2, *) ! mo_tot_num**2 - integer, intent(out) :: n - logical :: ok - integer :: s1, s2, p1, p2, ib, j, istate - integer(bit_kind) :: mask(N_int, 2), det(N_int, 2) - - n = 0 - - if(sp == 3) then - s1 = 1 - s2 = 2 - else - s1 = sp - s2 = sp - end if - - call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int) - - do p1=1,mo_tot_num - if(bannedOrb(p1, s1)) cycle - ib = 1 - if(sp /= 3) ib = p1+1 - do p2=ib,mo_tot_num - if(bannedOrb(p2, s2)) cycle - if(banned(p1,p2)) cycle - n += 1 - call apply_particles(mask, s1, p1, s2, p2, abuf(1,1,n), ok, N_int) - if(.not. ok) stop "error in create_alpha_buffer" - end do - end do -end -double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2) - use bitmasks - implicit none - - integer, intent(in) :: phasemask(2,*) - integer, intent(in) :: s1, s2, h1, h2, p1, p2 - logical :: change - integer :: np1 - integer :: np - double precision, save :: res(0:1) = (/1d0, -1d0/) - - np1 = phasemask(s1,h1) + phasemask(s1,p1) + phasemask(s2,h2) + phasemask(s2,p2) - np = np1 - if(p1 < h1) np = np + 1 - if(p2 < h2) np = np + 1 - - if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1 - get_phase_bi = res(iand(np,1)) -end - - -subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) - use bitmasks - implicit none - - integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) - integer, intent(in) :: phasemask(2,N_int*bit_kind_size) - logical, intent(in) :: bannedOrb(mo_tot_num) - double precision, intent(in) :: coefs(N_states) - double precision, intent(inout) :: vect(N_states, mo_tot_num) - integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) - integer :: i, j, h1, h2, p1, p2, sfix, hfix, pfix, hmob, pmob, puti - double precision :: hij - double precision, external :: get_phase_bi, mo_bielec_integral - - integer, parameter :: turn3_2(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) - integer, parameter :: turn2(2) = (/2,1/) - - if(h(0,sp) == 2) then - h1 = h(1, sp) - h2 = h(2, sp) - do i=1,3 - puti = p(i, sp) - if(bannedOrb(puti)) cycle - p1 = p(turn3_2(1,i), sp) - p2 = p(turn3_2(2,i), sp) - hij = mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2, p1, h1, h2) - hij *= get_phase_bi(phasemask, sp, sp, h1, p1, h2, p2) - vect(:, puti) += hij * coefs - end do - else if(h(0,sp) == 1) then - sfix = turn2(sp) - hfix = h(1,sfix) - pfix = p(1,sfix) - hmob = h(1,sp) - do j=1,2 - puti = p(j, sp) - if(bannedOrb(puti)) cycle - pmob = p(turn2(j), sp) - hij = mo_bielec_integral(pfix, pmob, hfix, hmob) - hij *= get_phase_bi(phasemask, sp, sfix, hmob, pmob, hfix, pfix) - vect(:, puti) += hij * coefs - end do - else - puti = p(1,sp) - if(.not. bannedOrb(puti)) then - sfix = turn2(sp) - p1 = p(1,sfix) - p2 = p(2,sfix) - h1 = h(1,sfix) - h2 = h(2,sfix) - hij = (mo_bielec_integral(p1,p2,h1,h2) - mo_bielec_integral(p2,p1,h1,h2)) - hij *= get_phase_bi(phasemask, sfix, sfix, h1, p1, h2, p2) - vect(:, puti) += hij * coefs - end if - end if -end - - -subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) - use bitmasks - implicit none - - integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) - integer, intent(in) :: phasemask(2,N_int*bit_kind_size) - logical, intent(in) :: bannedOrb(mo_tot_num) - double precision, intent(in) :: coefs(N_states) - double precision, intent(inout) :: vect(N_states, mo_tot_num) - integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) - integer :: i, hole, p1, p2, sh - logical :: ok - - logical, allocatable :: lbanned(:) - integer(bit_kind) :: det(N_int, 2) - double precision :: hij - double precision, external :: get_phase_bi, mo_bielec_integral - - allocate (lbanned(mo_tot_num)) - lbanned = bannedOrb - sh = 1 - if(h(0,2) == 1) sh = 2 - hole = h(1, sh) - lbanned(p(1,sp)) = .true. - if(p(0,sp) == 2) lbanned(p(2,sp)) = .true. - !print *, "SPm1", sp, sh - - p1 = p(1, sp) - - if(sp == sh) then - p2 = p(2, sp) - lbanned(p2) = .true. - - do i=1,hole-1 - if(lbanned(i)) cycle - hij = (mo_bielec_integral(p1, p2, i, hole) - mo_bielec_integral(p2, p1, i, hole)) - hij *= get_phase_bi(phasemask, sp, sp, i, p1, hole, p2) - vect(1:N_states,i) += hij * coefs(1:N_states) - end do - do i=hole+1,mo_tot_num - if(lbanned(i)) cycle - hij = (mo_bielec_integral(p1, p2, hole, i) - mo_bielec_integral(p2, p1, hole, i)) - hij *= get_phase_bi(phasemask, sp, sp, hole, p1, i, p2) - vect(1:N_states,i) += hij * coefs(1:N_states) - end do - - call apply_particle(mask, sp, p2, det, ok, N_int) - call i_h_j(gen, det, N_int, hij) - vect(1:N_states, p2) += hij * coefs(1:N_states) - else - p2 = p(1, sh) - do i=1,mo_tot_num - if(lbanned(i)) cycle - hij = mo_bielec_integral(p1, p2, i, hole) - hij *= get_phase_bi(phasemask, sp, sh, i, p1, hole, p2) - vect(1:N_states,i) += hij * coefs(1:N_states) - end do - end if - - call apply_particle(mask, sp, p1, det, ok, N_int) - call i_h_j(gen, det, N_int, hij) - vect(1:N_states, p1) += hij * coefs(1:N_states) -end - - -subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) - use bitmasks - implicit none - - integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) - integer, intent(in) :: phasemask(2,N_int*bit_kind_size) - logical, intent(in) :: bannedOrb(mo_tot_num) - double precision, intent(in) :: coefs(N_states) - double precision, intent(inout) :: vect(N_states, mo_tot_num) - integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) - integer :: i - logical :: ok - - logical, allocatable :: lbanned(:) - integer(bit_kind) :: det(N_int, 2) - double precision :: hij - - allocate(lbanned(mo_tot_num)) - lbanned = bannedOrb - lbanned(p(1,sp)) = .true. - do i=1,mo_tot_num - if(lbanned(i)) cycle - call apply_particle(mask, sp, i, det, ok, N_int) - call i_h_j(gen, det, N_int, hij) - vect(1:N_states, i) += hij * coefs(1:N_states) - end do -end - - - -subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) +subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob, countedOrb, counted, interesting) use bitmasks implicit none @@ -595,14 +377,16 @@ subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interes integer, intent(in) :: interesting(0:N_sel) integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2) - integer, intent(inout) :: mat(mo_tot_num, mo_tot_num) + integer, intent(inout) :: countedGlob, countedOrb(mo_tot_num, 2), counted(mo_tot_num, mo_tot_num) + - integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt + integer :: i, s, ii, j, k, l, h(0:2,2), p(0:4,2), nt integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) - integer :: phasemask(2,N_int*bit_kind_size) PROVIDE psi_selectors_coef_transp - mat = 0 + countedGlob = 0 + countedOrb = 0 + counted = 0 do i=1,N_int negMask(i,1) = not(mask(i,1)) @@ -631,19 +415,34 @@ subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interes if(nt > 4) cycle if (interesting(i) == i_gen) then - if(sp == 3) then - do j=1,mo_tot_num - do k=1,mo_tot_num - banned(j,k,2) = banned(k,j,1) - enddo - enddo - else - do k=1,mo_tot_num - do l=k+1,mo_tot_num - banned(l,k,1) = banned(k,l,1) - end do - end do + do s=1,2 + do j=1,mo_tot_num + if(bannedOrb(j, s)) then + if(sp == 3 .and. s == 1) then + banned(j, :, 1) = .true. + else if(sp == 3 .and. s == 2) then + banned(:, j, 1) = .true. + else if(s == sp) then + banned(j,:,1) = .true. + banned(:,j,1) = .true. + end if end if + end do + end do + + if(sp == 3) then + do j=1,mo_tot_num + do k=1,mo_tot_num + banned(j,k,2) = banned(k,j,1) + enddo + enddo + else + do k=1,mo_tot_num + do l=k+1,mo_tot_num + banned(l,k,1) = banned(k,l,1) + end do + end do + end if end if call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) @@ -660,133 +459,157 @@ subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interes call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int) if (interesting(i) >= i_gen) then - call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask) if(nt == 4) then - call count_d2(mat, p, sp) + call count_d2(counted, p, sp) else if(nt == 3) then - call count_d1(mat, p, sp) + call count_d1(countedOrb, p) else - mat(:,:) = mat(:,:) + 1 + countedGlob += 1 end if else if(nt == 4) call past_d2(banned, p, sp) if(nt == 3) call past_d1(bannedOrb, p) + if(nt < 3) stop "past_d0 ?" end if end do + do i=1,mo_tot_num + if(bannedOrb(i,1)) countedOrb(i,1) = 0 + if(bannedOrb(i,2)) countedOrb(i,2) = 0 + do j=1,mo_tot_num + if(banned(i,j,1)) counted(i,j) = 0 + end do + end do + + if(sp /= 3) then + countedOrb(:, mod(sp, 2)+1) = 0 + end if + + ! USELESS? + !do j=1,2 + ! do i=1,mo_tot_num + ! if(bannedOrb(i, j)) then + ! countedOrb(i, j) = 0 + ! if(sp == 3 .and. j == 1) then + ! counted(i, :) = 0 + ! else if(sp == 3 .and. j == 2) then + ! counted(:, i) = 0 + ! else if(j == sp) then + ! counted(i,:) = 0 + ! counted(:,i) = 0 + ! end if + ! end if + ! end do + !end do +end + + + +!subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) +subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob, countedOrb, counted, interesting) + use bitmasks + implicit none + + integer, intent(in) :: sp, i_gen, N_sel + integer, intent(in) :: interesting(0:N_sel) + integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) + logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2) + integer, intent(inout) :: countedGlob, countedOrb(mo_tot_num, 2), counted(mo_tot_num, mo_tot_num) + integer :: counted2(mo_tot_num, mo_tot_num), countedOrb2(mo_tot_num, 2) + integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt, s + integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) + integer :: phasemask(2,N_int*bit_kind_size) + + counted2 = counted + countedOrb2 = countedOrb + PROVIDE psi_selectors_coef_transp + do i=1,N_int + negMask(i,1) = not(mask(i,1)) + negMask(i,2) = not(mask(i,2)) + end do + + do i=1, N_sel ! interesting(0) + !i = interesting(ii) + if (interesting(i) < 0) then + stop 'prefetch interesting(i)' + endif + if(interesting(i) < i_gen) cycle + + + mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) + mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + + if(nt > 4) cycle + + do j=2,N_int + mobMask(j,1) = iand(negMask(j,1), det(j,1,i)) + mobMask(j,2) = iand(negMask(j,2), det(j,2,i)) + nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + end do + + if(nt > 4) cycle + + + call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) + call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) + + perMask(1,1) = iand(mask(1,1), not(det(1,1,i))) + perMask(1,2) = iand(mask(1,2), not(det(1,2,i))) + do j=2,N_int + perMask(j,1) = iand(mask(j,1), not(det(j,1,i))) + perMask(j,2) = iand(mask(j,2), not(det(j,2,i))) + end do + + call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int) + call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int) + + if (interesting(i) >= i_gen) then + !call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask) + if(nt == 4) then + call get_d2(det(1,1,i), phasemask, bannedOrb, banned, counted, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + else if(nt == 3) then + call get_d1(det(1,1,i), phasemask, bannedOrb, banned, counted, countedOrb, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + else + countedGlob -= 1 + !call get_d0(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + end if + !else + ! if(nt == 4) call past_d2(banned, p, sp) + ! if(nt == 3) call past_d1(bannedOrb, p) + end if + end do + + if(countedGlob /= 0) stop "nonul glob" + + do s=1,2 + do i=1,mo_tot_num + if(countedOrb(i, s) /= 0) then + print *, "COUNTEDORB", sp, s, bannedOrb(i,s), countedOrb2(i, s), countedOrb(i, s) + !stop "COUNERe" + end if + end do + end do + do i=1,mo_tot_num do j=1,mo_tot_num - if(banned(i,j,1)) mat(i,j) = 0 - end do - end do - - if(sp == 3) then - do i=1,mo_tot_num - if(bannedOrb(i, 1)) mat(i, :) = 0 - if(bannedOrb(i, 2)) mat(:, i) = 0 - end do - else - do i=1,mo_tot_num - if(bannedOrb(i, sp)) then - mat(:,i) = 0 - mat(i,:) = 0 + if(counted2(i,j) /= 0) then + if(counted(i,j) /= 0) then + print *, counted(i,j) + stop "nonul" + end if + else + if(counted(i,j) /= 0) then + print *, counted2(i,j), counted(i,j) + stop "UNCOUNTED" end if - end do - end if -end - - - -subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) - use bitmasks - implicit none - - integer, intent(in) :: sp, i_gen, N_sel - integer, intent(in) :: interesting(0:N_sel) - integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) - logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2) - double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) - - integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt - integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) - integer :: phasemask(2,N_int*bit_kind_size) - - PROVIDE psi_selectors_coef_transp - mat = 0d0 - - do i=1,N_int - negMask(i,1) = not(mask(i,1)) - negMask(i,2) = not(mask(i,2)) - end do - - do i=1, N_sel ! interesting(0) - !i = interesting(ii) - if (interesting(i) < 0) then - stop 'prefetch interesting(i)' - endif - - - mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) - mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) - nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) - - if(nt > 4) cycle - - do j=2,N_int - mobMask(j,1) = iand(negMask(j,1), det(j,1,i)) - mobMask(j,2) = iand(negMask(j,2), det(j,2,i)) - nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) - end do - - if(nt > 4) cycle - - if (interesting(i) == i_gen) then - if(sp == 3) then - do j=1,mo_tot_num - do k=1,mo_tot_num - banned(j,k,2) = banned(k,j,1) - enddo - enddo - else - do k=1,mo_tot_num - do l=k+1,mo_tot_num - banned(l,k,1) = banned(k,l,1) - end do - end do - end if - end if - - call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) - call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) - - perMask(1,1) = iand(mask(1,1), not(det(1,1,i))) - perMask(1,2) = iand(mask(1,2), not(det(1,2,i))) - do j=2,N_int - perMask(j,1) = iand(mask(j,1), not(det(j,1,i))) - perMask(j,2) = iand(mask(j,2), not(det(j,2,i))) - end do - - call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int) - call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int) - - if (interesting(i) >= i_gen) then - call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask) - if(nt == 4) then - call get_d2(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - else if(nt == 3) then - call get_d1(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - else - call get_d0(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - end if - else - if(nt == 4) call past_d2(banned, p, sp) - if(nt == 3) call past_d1(bannedOrb, p) end if end do -end + end do +end subroutine -subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) +subroutine get_d2(gen, phasemask, bannedOrb, banned, counted, mask, h, p, sp, coefs) use bitmasks implicit none @@ -794,7 +617,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) integer, intent(in) :: phasemask(2,N_int*bit_kind_size) logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) double precision, intent(in) :: coefs(N_states) - double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + integer, intent(inout) :: counted(mo_tot_num, mo_tot_num) integer, intent(in) :: h(0:2,2), p(0:4,2), sp double precision, external :: get_phase_bi, mo_bielec_integral @@ -834,9 +657,9 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) if(ma == 1) then - mat(:, putj, puti) += coefs(:) * hij + counted(putj, puti) -= 1!coefs(:) * hij else - mat(:, puti, putj) += coefs(:) * hij + counted(puti, putj) -= 1!coefs(:) * hij end if end do else @@ -852,7 +675,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) p1 = p(turn2(i), 1) hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) - mat(:, puti, putj) += coefs(:) * hij + counted(puti, putj) -= 1!coefs(:) * hij end do end do end if @@ -872,7 +695,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) p1 = p(i1, ma) p2 = p(i2, ma) hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) - mat(:, puti, putj) += coefs(:) * hij + counted(puti, putj) -= 1!coefs(:) * hij end do end do else if(tip == 3) then @@ -886,7 +709,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) p2 = p(i, ma) hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2) - mat(:, min(puti, putj), max(puti, putj)) += coefs(:) * hij + counted(min(puti, putj), max(puti, putj)) -= 1!coefs(:) * hij end do else ! tip == 4 puti = p(1, sp) @@ -897,14 +720,14 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) h1 = h(1, mi) h2 = h(2, mi) hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2) - mat(:, puti, putj) += coefs(:) * hij + counted(puti, putj) -= 1!coefs(:) * hij end if end if end if end -subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) +subroutine get_d1(gen, phasemask, bannedOrb, banned, counted, countedOrb, mask, h, p, sp, coefs) use bitmasks implicit none @@ -913,7 +736,8 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) integer(bit_kind) :: det(N_int, 2) double precision, intent(in) :: coefs(N_states) - double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + integer, intent(inout) :: counted(mo_tot_num, mo_tot_num) + integer, intent(inout) :: countedOrb(mo_tot_num, 2) integer, intent(in) :: h(0:2,2), p(0:4,2), sp double precision :: hij, tmp_row(N_states, mo_tot_num), tmp_row2(N_states, mo_tot_num) double precision, external :: get_phase_bi, mo_bielec_integral @@ -966,9 +790,11 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) end do if(ma == 1) then - mat(1:N_states,1:mo_tot_num,puti) += tmp_row(1:N_states,1:mo_tot_num) + !mat(1:N_states,1:mo_tot_num,puti) += tmp_row(1:N_states,1:mo_tot_num) + countedOrb(puti, 2) -= 1 else - mat(1:N_states,puti,1:mo_tot_num) += tmp_row(1:N_states,1:mo_tot_num) + !mat(1:N_states,puti,1:mo_tot_num) += tmp_row(1:N_states,1:mo_tot_num) + countedOrb(puti, 1) -= 1 end if end if @@ -993,11 +819,15 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) end do if(mi == 1) then - mat(:,:,p1) += tmp_row(:,:) - mat(:,:,p2) += tmp_row2(:,:) + !mat(:,:,p1) += tmp_row(:,:) + if(.not. bannedOrb(p1, 2)) countedOrb(p1, 2) = countedOrb(p1,2) - 1 + !mat(:,:,p2) += tmp_row2(:,:) + if(.not. bannedOrb(p2, 2)) countedOrb(p2, 2) = countedOrb(p2,2)-1 else - mat(:,p1,:) += tmp_row(:,:) - mat(:,p2,:) += tmp_row2(:,:) + !mat(:,p1,:) += tmp_row(:,:) + if(.not. bannedOrb(p1, 1)) countedOrb(p1, 1) = countedOrb(p1,1)-1 + !mat(:,p2,:) += tmp_row2(:,:) + if(.not. bannedOrb(p2, 1)) countedOrb(p2, 1) = countedOrb(p2,1)-1 end if else if(p(0,ma) == 3) then @@ -1018,8 +848,11 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) tmp_row(:,putj) += hij * coefs(:) end do - mat(:, :puti-1, puti) += tmp_row(:,:puti-1) - mat(:, puti, puti:) += tmp_row(:,puti:) + !mat(:, :puti-1, puti) += tmp_row(:,:puti-1) + !mat(:, puti, puti:) += tmp_row(:,puti:) + if(.not. bannedOrb(puti, sp)) then + countedOrb(puti, sp) -= 1 + end if end do else hfix = h(1,mi) @@ -1042,10 +875,16 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) tmp_row2(:,puti) += hij * coefs(:) end if end do - mat(:,:p2-1,p2) += tmp_row(:,:p2-1) - mat(:,p2,p2:) += tmp_row(:,p2:) - mat(:,:p1-1,p1) += tmp_row2(:,:p1-1) - mat(:,p1,p1:) += tmp_row2(:,p1:) + !mat(:,:p2-1,p2) += tmp_row(:,:p2-1) + !mat(:,p2,p2:) += tmp_row(:,p2:) + if(.not. bannedOrb(p2, sp)) then + countedOrb(p2, sp) -= 1 + end if + !mat(:,:p1-1,p1) += tmp_row2(:,:p1-1) + !mat(:,p1,p1:) += tmp_row2(:,p1:) + if(.not. bannedOrb(p1, sp)) then + countedOrb(p1, sp) -= 1 + end if end if end if @@ -1067,7 +906,8 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) call i_h_j(gen, det, N_int, hij) - mat(:, p1, p2) += coefs(:) * hij + !mat(:, p1, p2) += coefs(:) * hij + !!!!!!!! DUPLICTATE counted(p1, p2) !!!!!!!!!!!!!!!!!!!! end do end do end @@ -1149,65 +989,6 @@ subroutine past_d1(bannedOrb, p) end -subroutine count_d1(mat, p, sp) - use bitmasks - implicit none - - integer, intent(inout) :: mat(mo_tot_num, mo_tot_num) - integer, intent(in) :: p(0:4, 2), sp - integer :: i,s,j - - - if(sp == 3) then - do i=1,p(0,1) - mat(p(i,1), :) += 1 - end do - do i=1,p(0,2) - mat(:, p(i,2)) += 1 - end do - - do i=1,p(0,1) - do j=1,p(0,2) - mat(p(i,1), p(j,2)) -= 1 - end do - end do - else - if(sp == 1 .and. p(0,2) /= 0) stop "count_d1 bug" - if(sp == 2 .and. p(0,1) /= 0) stop "count_d1 bug" - do i=1,p(0,sp) - mat(:p(i,sp), p(i,sp)) += 1 - mat(p(i,sp), p(i,sp):) += 1 - mat(p(i,sp), p(i,sp)) -= 1 - end do - end if -end - - -subroutine count_d2(mat, p, sp) - use bitmasks - implicit none - - integer, intent(inout) :: mat(mo_tot_num, mo_tot_num) - integer, intent(in) :: p(0:4, 2), sp - integer :: i,j - - if(sp == 3) then - do i=1,p(0,1) - do j=1,p(0,2) - mat(p(i,1), p(j,2)) += 1 - end do - end do - else - do i=1,p(0, sp) - do j=1,i-1 - mat(p(j,sp), p(i,sp)) += 1 - mat(p(i,sp), p(j,sp)) += 1 - end do - end do - end if -end - - subroutine past_d2(banned, p, sp) use bitmasks implicit none @@ -1225,6 +1006,7 @@ subroutine past_d2(banned, p, sp) else do i=1,p(0, sp) do j=1,i-1 + if(p(j,sp) > p(i,sp)) stop "PPPPPPPP" banned(p(j,sp), p(i,sp)) = .true. banned(p(i,sp), p(j,sp)) = .true. end do @@ -1233,6 +1015,48 @@ subroutine past_d2(banned, p, sp) end +subroutine count_d1(countedOrb, p) + use bitmasks + implicit none + + integer, intent(inout) :: countedOrb(mo_tot_num, 2) + integer, intent(in) :: p(0:4, 2) + integer :: i,s + + do s = 1, 2 + do i = 1, p(0, s) + countedOrb(p(i, s), s) += 1 + end do + end do +end + + +subroutine count_d2(counted, p, sp) + use bitmasks + implicit none + + integer, intent(inout) :: counted(mo_tot_num, mo_tot_num) + integer, intent(in) :: p(0:4, 2), sp + integer :: i,j + + if(sp == 3) then + do i=1,p(0,1) + do j=1,p(0,2) + counted(p(i,1), p(j,2)) += 1 + end do + end do + else + do i=1,p(0, sp) + do j=1,i-1 + counted(p(j,sp), p(i,sp)) += 1 + !counted(p(i,sp), p(j,sp)) += 1 + end do + end do + end if +end + + + subroutine spot_isinwf(mask, det, i_gen, N, banned, fullMatch, interesting) use bitmasks implicit none @@ -1304,3 +1128,65 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint) enddo end + + + +subroutine create_alpha_buffer(i_generator, sp, h1, h2, bannedOrb, banned, abuf, n) + use bitmasks + implicit none + + integer, intent(in) :: i_generator, sp, h1, h2 + logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num) + integer(bit_kind),intent(inout) :: abuf(N_int, 2, *) ! mo_tot_num**2 + integer, intent(out) :: n + logical :: ok + integer :: s1, s2, p1, p2, ib, j, istate + integer(bit_kind) :: mask(N_int, 2), det(N_int, 2) + + n = 0 + + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + + call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int) + + do p1=1,mo_tot_num + if(bannedOrb(p1, s1)) cycle + ib = 1 + if(sp /= 3) ib = p1+1 + do p2=ib,mo_tot_num + if(bannedOrb(p2, s2)) cycle + if(banned(p1,p2)) cycle + n += 1 + call apply_particles(mask, s1, p1, s2, p2, abuf(1,1,n), ok, N_int) + if(.not. ok) stop "error in create_alpha_buffer" + end do + end do +end + + +double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2) + use bitmasks + implicit none + + integer, intent(in) :: phasemask(2,*) + integer, intent(in) :: s1, s2, h1, h2, p1, p2 + logical :: change + integer :: np1 + integer :: np + double precision, save :: res(0:1) = (/1d0, -1d0/) + + np1 = phasemask(s1,h1) + phasemask(s1,p1) + phasemask(s2,h2) + phasemask(s2,p2) + np = np1 + if(p1 < h1) np = np + 1 + if(p2 < h2) np = np + 1 + + if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1 + get_phase_bi = res(iand(np,1)) +end + diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index 205c480b..173d8d26 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -3,12 +3,12 @@ program mrcc_sto BEGIN_DOC ! TODO END_DOC - print *, "!!!!!!========================!!!!!!" - print *, "!!!!!!========================!!!!!!" - print *, "!!!!!!========================!!!!!!" + print *, "========================" + print *, "========================" + print *, "========================" print *, "MRCC_STO not implemented - acts as a unittest for dress_zmq" - print *, "!!!!!!========================!!!!!!" - print *, "!!!!!!========================!!!!!!" - print *, "!!!!!!========================!!!!!!" + print *, "========================" + print *, "========================" + print *, "========================" call dress_zmq() end From ab0eb1256b7e1f4f78fe0cd712707a69347a5530 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 15 Feb 2018 12:00:45 +0100 Subject: [PATCH 26/65] Fixed state_average_weight.gz different from array --- configure | 2 +- ocaml/Input_determinants_by_hand.ml | 30 +++++++++++++++++++---------- 2 files changed, 21 insertions(+), 11 deletions(-) diff --git a/configure b/configure index 9f677e92..544770e1 100755 --- a/configure +++ b/configure @@ -497,7 +497,7 @@ def create_ninja_and_rc(l_installed): 'export LIBRARY_PATH=$(qp_prepend_export "LIBRARY_PATH" "${QP_ROOT}"/lib:"${QP_ROOT}"/lib64)', 'export C_INCLUDE_PATH=$(qp_prepend_export "C_INCLUDE_PATH" "${QP_ROOT}"/include)', '', - 'if [[ $SHELL == "bash" ]] ; then', + 'if [[ $SHELL == "/bin/bash" ]] ; then', ' source ${QP_ROOT}/install/EZFIO/Bash/ezfio.sh', 'fi', '', diff --git a/ocaml/Input_determinants_by_hand.ml b/ocaml/Input_determinants_by_hand.ml index ecc68e70..b61f1ee7 100644 --- a/ocaml/Input_determinants_by_hand.ml +++ b/ocaml/Input_determinants_by_hand.ml @@ -119,21 +119,31 @@ end = struct ;; let read_state_average_weight () = + let n_states = + read_n_states () + |> States_number.to_int + in if not (Ezfio.has_determinants_state_average_weight ()) then - begin - let n_states = - read_n_states () - |> States_number.to_int - in + begin let data = Array.init n_states (fun _ -> 1./.(float_of_int n_states)) |> Array.map ~f:Positive_float.of_float in - write_state_average_weight data; - end; - Ezfio.get_determinants_state_average_weight () - |> Ezfio.flattened_ezfio - |> Array.map ~f:Positive_float.of_float + write_state_average_weight data + end; + let result = + Ezfio.get_determinants_state_average_weight () + |> Ezfio.flattened_ezfio + |> Array.map ~f:Positive_float.of_float + in + if Array.length result = n_states then + result + else + let data = + Array.init n_states (fun _ -> 1./.(float_of_int n_states)) + |> Array.map ~f:Positive_float.of_float + in + (write_state_average_weight data; data) ;; let read_expected_s2 () = From a828a1c5c8b367594937528f0a90769d4f382b44 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 15 Feb 2018 13:42:55 +0100 Subject: [PATCH 27/65] PQ leaves in alpha_factory - with duplicate determinants --- plugins/dress_zmq/alpha_factory.irp.f | 575 +++++++++++++------------- plugins/mrcc_sto/mrcc_dress.irp.f | 29 +- 2 files changed, 299 insertions(+), 305 deletions(-) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index cd9df4be..663bd380 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -2,33 +2,6 @@ use bitmasks -subroutine get_mask_phase(det, phasemask) - use bitmasks - implicit none - - integer(bit_kind), intent(in) :: det(N_int, 2) - integer, intent(out) :: phasemask(2,N_int*bit_kind_size) - integer :: s, ni, i - logical :: change - - phasemask = 0_1 - do s=1,2 - change = .false. - do ni=1,N_int - do i=0,bit_kind_size-1 - if(BTEST(det(ni, s), i)) then - change = .not. change - endif - if(change) then - phasemask(s, ishft(ni-1,bit_kind_shift) + i + 1) = 1_1 - endif - end do - end do - end do -end subroutine - - - subroutine alpha_callback(delta_ij_loc, i_generator, subset) use bitmasks implicit none @@ -65,17 +38,17 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) logical, allocatable :: banned(:,:,:), bannedOrb(:,:) integer, allocatable :: counted(:,:), countedOrb(:,:) - integer :: countedGlob + integer :: countedGlob, siz, lsiz - double precision, allocatable :: mat(:,:,:) + integer, allocatable :: indexes_end(:,:), indexes(:,:) logical :: monoAdo, monoBdo integer :: maskInd integer(bit_kind), allocatable:: preinteresting_det(:,:,:) - integer(bit_kind),allocatable :: abuf(:,:,:) + integer ,allocatable :: abuf(:), labuf(:) - allocate(abuf(N_int, 2, mo_tot_num**2)) + allocate(abuf(N_det*6), labuf(N_det)) allocate(preinteresting_det(N_int,2,N_det)) PROVIDE fragment_count @@ -164,7 +137,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index negMask(i,1) = not(psi_det_generators(i,1,i_generator)) negMask(i,2) = not(psi_det_generators(i,2,i_generator)) end do - + if(psi_det_generators(1,1,i_generator) /= psi_det_sorted(1,1,i_generator)) stop "gen <> sorted" do k=1,nmax i = indices(k) mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i)) @@ -195,7 +168,8 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index allocate(minilist(N_int, 2, N_det_selectors), fullminilist(N_int, 2, N_det)) allocate(banned(mo_tot_num, mo_tot_num,2), bannedOrb(mo_tot_num, 2)) allocate(counted(mo_tot_num, mo_tot_num), countedOrb(mo_tot_num, 2)) - allocate (mat(N_states, mo_tot_num, mo_tot_num)) + allocate (indexes(0:mo_tot_num, 0:mo_tot_num)) + allocate (indexes_end(0:mo_tot_num, 0:mo_tot_num)) maskInd = -1 integer :: nb_count do s1=1,2 @@ -354,8 +328,21 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index if(fullMatch) cycle call count_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, countedGlob, countedOrb, counted, interesting) - call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, countedGlob, countedOrb, counted, interesting) - !call create_alpha_buffer(i_generator, sp, h1, h2, bannedOrb, banned, abuf, n) + call create_indexes(countedGlob, countedOrb, counted, indexes, siz) + indexes_end = indexes + + + if(siz > size(abuf)) stop "buffer too small in alpha_factory" + abuf = 0 + call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, indexes_end, abuf, interesting) + indexes_end(:,:) -= 1 + do i=1,siz + if(abuf(i) < 1 .or. abuf(i) > N_det) stop "foireous abuf" + end do + !print *, "IND1", indexes(1,:) + !print *, "IND2", indexes_end(1,:) + !stop + call alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz) !call dress_with_alpha_buffer(delta_ij_loc, minilist, interesting(0), abuf, n) end if @@ -367,6 +354,119 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index end subroutine +subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz) + use bitmasks + implicit none + + double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) + integer, intent(in) :: sp, indexes(0:mo_tot_num, 0:mo_tot_num), siz + integer, intent(in) :: indexes_end(0:mo_tot_num, 0:mo_tot_num), abuf(*) + logical, intent(in) :: bannedOrb(mo_tot_num,2), banned(mo_tot_num, mo_tot_num) + integer(bit_kind), intent(in) :: mask(N_int, 2) + integer(bit_kind) :: alpha(N_int, 2, 1) + integer, allocatable :: labuf(:) + logical :: ok + integer :: i,j,s,st1,st2,st3,st4 + integer :: lindex(mo_tot_num,2), lindex_end(mo_tot_num, 2) + integer :: s1, s2, stamo + + allocate(labuf(N_det)) + st1 = indexes_end(0,0) + if(st1 > 0) labuf(:st1) = abuf(:st1) + st1 += 1 + + if(sp == 3) then + s1 = 1 + s2 = 2 + lindex(:, 1) = indexes(1:,0) + lindex_end(:,1) = indexes_end(1:,0) + lindex(:, 2) = indexes(0, 1:) + lindex_end(:, 2) = indexes_end(0, 1:) + else if(sp == 2) then + s1 = 2 + s2 = 2 + !lindex(:, 1) = indexes(0, 1:) + !lindex_end(:,1) = indexes_end(0, 1:) + lindex(:, 2) = indexes(0, 1:) + lindex_end(:, 2) = indexes_end(0, 1:) + else if(sp == 1) then + s1 = 1 + s2 = 1 + lindex(:, 1) = indexes(1:, 0) + lindex_end(:,1) = indexes_end(1:, 0) + !lindex(:, 2) = indexes(1:, 0) + !lindex_end(:, 2) = indexes_end(1:, 0) + end if + + do i=1,mo_tot_num + if(bannedOrb(i,s1)) cycle + if(lindex(i,s1) /= 0) then + st2 = st1 + 1 + lindex_end(i,s1)-lindex(i,s1) + labuf(st1:st2-1) = abuf(lindex(i,s1):lindex_end(i,s1)) + else + st2 = st1 + end if + + if(sp == 3) then + stamo = 1 + else + stamo = i+1 + end if + + do j=stamo,mo_tot_num + if(bannedOrb(j,s2) .or. banned(i,j)) cycle + if(lindex(j,s2) /= 0) then + st3 = st2 + 1 + lindex_end(j,s2)-lindex(j,s2) + labuf(st2:st3-1) = abuf(lindex(j,s2):lindex_end(j,s2)) + else + st3 = st2 + end if + + if(indexes(i,j) /= 0) then + st4 = st3 + 1 + indexes_end(i,j)-indexes(i,j) + labuf(st3:st4-1) = abuf(indexes(i,j):indexes_end(i,j)) + else + st4 = st3 + end if + !APPLY PART + if(st4 > 1) then + call apply_particles(mask, s1, i, s2, j, alpha(1,1,1), ok, N_int) + if(.not. ok) stop "non existing alpha......" + !print *, "willcall", st4-1, size(labuf) + call dress_with_alpha_buffer(delta_ij_loc, labuf, st4-1, alpha, 1) + !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) + end if + end do + end do +end subroutine + + +subroutine create_indexes(countedGlob, countedOrb, counted, indexes, siz) + use bitmasks + implicit none + + integer, intent(in) :: countedGlob, countedOrb(mo_tot_num,2), counted(mo_tot_num, mo_tot_num) + integer, intent(out) :: indexes(0:mo_tot_num, 0:mo_tot_num), siz + integer :: tmp, i, j + + indexes(0, 0) = countedGlob + indexes(0, 1:) = countedOrb(:, 2) + indexes(1:, 0) = countedOrb(:, 1) + indexes(1:, 1:) = counted(:,:) + + siz = 1 + + do i=0, mo_tot_num + do j=0, mo_tot_num + if(indexes(i,j) == 0) cycle + tmp = indexes(i,j) + indexes(i,j) = siz + siz += tmp + end do + end do + + siz -= 1 +end subroutine subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob, countedOrb, counted, interesting) @@ -484,29 +584,11 @@ subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob, if(sp /= 3) then countedOrb(:, mod(sp, 2)+1) = 0 end if - - ! USELESS? - !do j=1,2 - ! do i=1,mo_tot_num - ! if(bannedOrb(i, j)) then - ! countedOrb(i, j) = 0 - ! if(sp == 3 .and. j == 1) then - ! counted(i, :) = 0 - ! else if(sp == 3 .and. j == 2) then - ! counted(:, i) = 0 - ! else if(j == sp) then - ! counted(i,:) = 0 - ! counted(:,i) = 0 - ! end if - ! end if - ! end do - !end do end -!subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) -subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob, countedOrb, counted, interesting) +subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, indexes, abuf, interesting) use bitmasks implicit none @@ -514,14 +596,12 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob integer, intent(in) :: interesting(0:N_sel) integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2) - integer, intent(inout) :: countedGlob, countedOrb(mo_tot_num, 2), counted(mo_tot_num, mo_tot_num) - integer :: counted2(mo_tot_num, mo_tot_num), countedOrb2(mo_tot_num, 2) + integer, intent(inout) :: indexes(0:mo_tot_num, 0:mo_tot_num) + integer, intent(inout) :: abuf(*) integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt, s integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) integer :: phasemask(2,N_int*bit_kind_size) - counted2 = counted - countedOrb2 = countedOrb PROVIDE psi_selectors_coef_transp do i=1,N_int negMask(i,1) = not(mask(i,1)) @@ -565,62 +645,33 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int) if (interesting(i) >= i_gen) then - !call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask) - if(nt == 4) then - call get_d2(det(1,1,i), phasemask, bannedOrb, banned, counted, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - else if(nt == 3) then - call get_d1(det(1,1,i), phasemask, bannedOrb, banned, counted, countedOrb, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - else - countedGlob -= 1 - !call get_d0(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) - end if - !else - ! if(nt == 4) call past_d2(banned, p, sp) - ! if(nt == 3) call past_d1(bannedOrb, p) + if(nt == 4) then + call get_d2(interesting(i), det(1,1,i), banned, bannedOrb, indexes, abuf, mask, h, p, sp) + else if(nt == 3) then + call get_d1(interesting(i), det(1,1,i), banned, bannedOrb, indexes, abuf, mask, h, p, sp) + else + if(abuf(indexes(0,0)) /= 0) stop "noz" + abuf(indexes(0,0)) = interesting(i) + indexes(0,0) += 1 + end if end if end do - - if(countedGlob /= 0) stop "nonul glob" - - do s=1,2 - do i=1,mo_tot_num - if(countedOrb(i, s) /= 0) then - print *, "COUNTEDORB", sp, s, bannedOrb(i,s), countedOrb2(i, s), countedOrb(i, s) - !stop "COUNERe" - end if - end do - end do - - do i=1,mo_tot_num - do j=1,mo_tot_num - if(counted2(i,j) /= 0) then - if(counted(i,j) /= 0) then - print *, counted(i,j) - stop "nonul" - end if - else - if(counted(i,j) /= 0) then - print *, counted2(i,j), counted(i,j) - stop "UNCOUNTED" - end if - end if - end do - end do end subroutine -subroutine get_d2(gen, phasemask, bannedOrb, banned, counted, mask, h, p, sp, coefs) +subroutine get_d2(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) use bitmasks implicit none integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) - integer, intent(in) :: phasemask(2,N_int*bit_kind_size) + integer, intent(inout) :: abuf(*) + integer, intent(in) :: i_gen logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) - double precision, intent(in) :: coefs(N_states) - integer, intent(inout) :: counted(mo_tot_num, mo_tot_num) + integer, intent(inout) :: indexes(0:mo_tot_num, 0:mo_tot_num) integer, intent(in) :: h(0:2,2), p(0:4,2), sp - double precision, external :: get_phase_bi, mo_bielec_integral + !double precision, external :: get_phase_bi + double precision, external :: mo_bielec_integral integer :: i, j, tip, ma, mi, puti, putj integer :: h1, h2, p1, p2, i1, i2 @@ -631,6 +682,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, counted, mask, h, p, sp, co integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) integer :: bant + integer :: phasemask(2,N_int*bit_kind_size) bant = 1 tip = p(0,1) * p(0,2) @@ -655,11 +707,15 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, counted, mask, h, p, sp, co h1 = h(1, ma) h2 = h(2, ma) - hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) + !hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) if(ma == 1) then - counted(putj, puti) -= 1!coefs(:) * hij + if(abuf(indexes(putj,puti)) /= 0) stop "noz" + abuf(indexes(putj, puti)) = i_gen + indexes(putj, puti) += 1 else - counted(puti, putj) -= 1!coefs(:) * hij + if(abuf(indexes(puti,putj)) /= 0) stop "noz" + abuf(indexes(puti, putj)) = i_gen + indexes(puti, putj) += 1 end if end do else @@ -674,8 +730,11 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, counted, mask, h, p, sp, co if(banned(puti,putj,bant)) cycle p1 = p(turn2(i), 1) - hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) - counted(puti, putj) -= 1!coefs(:) * hij + !hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) + + if(abuf(indexes(puti,putj)) /= 0) stop "noz" + abuf(indexes(puti, putj)) = i_gen + indexes(puti, putj) += 1 end do end do end if @@ -694,8 +753,10 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, counted, mask, h, p, sp, co i2 = turn2d(2, i, j) p1 = p(i1, ma) p2 = p(i2, ma) - hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) - counted(puti, putj) -= 1!coefs(:) * hij + !hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) + if(abuf(indexes(puti,putj)) /= 0) stop "noz" + abuf(indexes(puti, putj)) = i_gen + indexes(puti, putj) += 1 end do end do else if(tip == 3) then @@ -708,8 +769,10 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, counted, mask, h, p, sp, co if(banned(puti,putj,1)) cycle p2 = p(i, ma) - hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2) - counted(min(puti, putj), max(puti, putj)) -= 1!coefs(:) * hij + !hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2) + if(abuf(indexes( min(puti, putj), max(puti, putj)) ) /= 0) stop "noz" + abuf(indexes(min(puti, putj), max(puti, putj))) = i_gen + indexes(min(puti, putj), max(puti, putj)) += 1 end do else ! tip == 4 puti = p(1, sp) @@ -719,28 +782,31 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, counted, mask, h, p, sp, co p2 = p(2, mi) h1 = h(1, mi) h2 = h(2, mi) - hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2) - counted(puti, putj) -= 1!coefs(:) * hij + !hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2) + + if(abuf(indexes(puti,putj)) /= 0) stop "noz" + abuf(indexes(puti, putj)) = i_gen + indexes(puti, putj) += 1 end if end if end if end -subroutine get_d1(gen, phasemask, bannedOrb, banned, counted, countedOrb, mask, h, p, sp, coefs) +subroutine get_d1(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) use bitmasks implicit none integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) - integer,intent(in) :: phasemask(2,N_int*bit_kind_size) + integer, intent(inout) :: abuf(*) + integer,intent(in) :: i_gen logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) integer(bit_kind) :: det(N_int, 2) - double precision, intent(in) :: coefs(N_states) - integer, intent(inout) :: counted(mo_tot_num, mo_tot_num) - integer, intent(inout) :: countedOrb(mo_tot_num, 2) + integer, intent(inout) :: indexes(0:mo_tot_num, 0:mo_tot_num) integer, intent(in) :: h(0:2,2), p(0:4,2), sp double precision :: hij, tmp_row(N_states, mo_tot_num), tmp_row2(N_states, mo_tot_num) - double precision, external :: get_phase_bi, mo_bielec_integral + !double precision, external :: get_phase_bi + double precision, external :: mo_bielec_integral logical :: ok logical, allocatable :: lbanned(:,:) @@ -751,6 +817,7 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, counted, countedOrb, mask, integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) integer :: bant + integer :: phasemask(2,N_int*bit_kind_size) allocate (lbanned(mo_tot_num, 2)) @@ -777,24 +844,30 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, counted, countedOrb, mask, p1 = p(1,ma) p2 = p(2,ma) if(.not. bannedOrb(puti, mi)) then - tmp_row = 0d0 - do putj=1, hfix-1 - if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle - hij = (mo_bielec_integral(p1, p2, putj, hfix)-mo_bielec_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) - tmp_row(1:N_states,putj) += hij * coefs(1:N_states) - end do - do putj=hfix+1, mo_tot_num - if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle - hij = (mo_bielec_integral(p1, p2, hfix, putj)-mo_bielec_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) - tmp_row(1:N_states,putj) += hij * coefs(1:N_states) - end do + !tmp_row = 0d0 + !do putj=1, hfix-1 + ! if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle + ! hij = (mo_bielec_integral(p1, p2, putj, hfix)-mo_bielec_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) + ! tmp_row(1:N_states,putj) += hij * coefs(1:N_states) + !end do + !do putj=hfix+1, mo_tot_num + ! if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle + ! hij = (mo_bielec_integral(p1, p2, hfix, putj)-mo_bielec_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) + ! tmp_row(1:N_states,putj) += hij * coefs(1:N_states) + !end do if(ma == 1) then !mat(1:N_states,1:mo_tot_num,puti) += tmp_row(1:N_states,1:mo_tot_num) - countedOrb(puti, 2) -= 1 + if(abuf(indexes(0,puti)) /= 0) stop "noz" + abuf(indexes(0, puti)) = i_gen + indexes(0, puti) += 1 + !countedOrb(puti, 2) -= 1 else !mat(1:N_states,puti,1:mo_tot_num) += tmp_row(1:N_states,1:mo_tot_num) - countedOrb(puti, 1) -= 1 + if(abuf(indexes(puti,0)) /= 0) stop "noz" + abuf(indexes(puti, 0)) = i_gen + indexes(puti, 0) += 1 + !countedOrb(puti, 1) -= 1 end if end if @@ -806,28 +879,40 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, counted, countedOrb, mask, if(lbanned(puti,mi)) cycle !p1 fixed putj = p1 - if(.not. banned(putj,puti,bant)) then - hij = mo_bielec_integral(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix) - tmp_row(:,puti) += hij * coefs(:) - end if + !if(.not. banned(putj,puti,bant)) then + ! hij = mo_bielec_integral(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix) + ! tmp_row(:,puti) += hij * coefs(:) + !end if putj = p2 - if(.not. banned(putj,puti,bant)) then - hij = mo_bielec_integral(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix) - tmp_row2(:,puti) += hij * coefs(:) - end if + !if(.not. banned(putj,puti,bant)) then + ! hij = mo_bielec_integral(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix) + ! tmp_row2(:,puti) += hij * coefs(:) + !end if end do if(mi == 1) then - !mat(:,:,p1) += tmp_row(:,:) - if(.not. bannedOrb(p1, 2)) countedOrb(p1, 2) = countedOrb(p1,2) - 1 - !mat(:,:,p2) += tmp_row2(:,:) - if(.not. bannedOrb(p2, 2)) countedOrb(p2, 2) = countedOrb(p2,2)-1 + if(.not. bannedOrb(p1, 2)) then + if(abuf(indexes(0,p1)) /= 0) stop "noz" + abuf(indexes(0,p1)) = i_gen + indexes(0,p1) += 1 + end if + if(.not. bannedOrb(p2, 2)) then + if(abuf(indexes(0,p2)) /= 0) stop "noz" + abuf(indexes(0,p2)) = i_gen + indexes(0,p2) += 1 + end if else - !mat(:,p1,:) += tmp_row(:,:) - if(.not. bannedOrb(p1, 1)) countedOrb(p1, 1) = countedOrb(p1,1)-1 - !mat(:,p2,:) += tmp_row2(:,:) - if(.not. bannedOrb(p2, 1)) countedOrb(p2, 1) = countedOrb(p2,1)-1 + if(.not. bannedOrb(p1, 1)) then + if(abuf(indexes(p1,0)) /= 0) stop "noz" + abuf(indexes(p1,0)) = i_gen + indexes(p1,0) += 1 + end if + if(.not. bannedOrb(p2, 1)) then + if(abuf(indexes(p2,0)) /= 0) stop "noz" + abuf(indexes(p2,0)) = i_gen + indexes(p2,0) += 1 + end if end if else if(p(0,ma) == 3) then @@ -836,22 +921,30 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, counted, countedOrb, mask, puti = p(i, ma) p1 = p(turn3(1,i), ma) p2 = p(turn3(2,i), ma) - tmp_row = 0d0 - do putj=1,hfix-1 - if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle - hij = (mo_bielec_integral(p1, p2, putj, hfix)-mo_bielec_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) - tmp_row(:,putj) += hij * coefs(:) - end do - do putj=hfix+1,mo_tot_num - if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle - hij = (mo_bielec_integral(p1, p2, hfix, putj)-mo_bielec_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) - tmp_row(:,putj) += hij * coefs(:) - end do + !tmp_row = 0d0 + !do putj=1,hfix-1 + ! if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle + ! hij = (mo_bielec_integral(p1, p2, putj, hfix)-mo_bielec_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) + ! tmp_row(:,putj) += hij * coefs(:) + !end do + !do putj=hfix+1,mo_tot_num + ! if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle + ! hij = (mo_bielec_integral(p1, p2, hfix, putj)-mo_bielec_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) + ! tmp_row(:,putj) += hij * coefs(:) + !end do !mat(:, :puti-1, puti) += tmp_row(:,:puti-1) !mat(:, puti, puti:) += tmp_row(:,puti:) if(.not. bannedOrb(puti, sp)) then - countedOrb(puti, sp) -= 1 + if(sp == 1) then + if(abuf(indexes(puti,0)) /= 0) stop "noz" + abuf(indexes(puti, 0)) = i_gen + indexes(puti, 0) += 1 + else + if(abuf(indexes(0,puti)) /= 0) stop "noz" + abuf(indexes(0, puti)) = i_gen + indexes(0, puti) += 1 + end if end if end do else @@ -864,26 +957,38 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, counted, countedOrb, mask, do puti=1,mo_tot_num if(lbanned(puti,ma)) cycle putj = p2 - if(.not. banned(puti,putj,1)) then - hij = mo_bielec_integral(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1) - tmp_row(:,puti) += hij * coefs(:) - end if + !if(.not. banned(puti,putj,1)) then + ! hij = mo_bielec_integral(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1) + ! tmp_row(:,puti) += hij * coefs(:) + !end if putj = p1 - if(.not. banned(puti,putj,1)) then - hij = mo_bielec_integral(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2) - tmp_row2(:,puti) += hij * coefs(:) - end if + !if(.not. banned(puti,putj,1)) then + ! hij = mo_bielec_integral(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2) + ! tmp_row2(:,puti) += hij * coefs(:) + !end if end do - !mat(:,:p2-1,p2) += tmp_row(:,:p2-1) - !mat(:,p2,p2:) += tmp_row(:,p2:) if(.not. bannedOrb(p2, sp)) then - countedOrb(p2, sp) -= 1 + if(sp == 1) then + if(abuf(indexes(p2,0)) /= 0) stop "noz" + abuf(indexes(p2, 0)) = i_gen + indexes(p2, 0) += 1 + else + if(abuf(indexes(0,p2)) /= 0) stop "noz" + abuf(indexes(0, p2)) = i_gen + indexes(0, p2) += 1 + end if end if - !mat(:,:p1-1,p1) += tmp_row2(:,:p1-1) - !mat(:,p1,p1:) += tmp_row2(:,p1:) if(.not. bannedOrb(p1, sp)) then - countedOrb(p1, sp) -= 1 + if(sp == 1) then + if(abuf(indexes(p1,0)) /= 0) stop "noz" + abuf(indexes(p1, 0)) = i_gen + indexes(p1, 0) += 1 + else + if(abuf(indexes(0,p1)) /= 0) stop "noz" + abuf(indexes(0, p1)) = i_gen + indexes(0, p1) += 1 + end if end if end if end if @@ -913,66 +1018,6 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, counted, countedOrb, mask, end -subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) - use bitmasks - implicit none - - integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) - integer, intent(in) :: phasemask(2,N_int*bit_kind_size) - logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) - integer(bit_kind) :: det(N_int, 2) - double precision, intent(in) :: coefs(N_states) - double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) - integer, intent(in) :: h(0:2,2), p(0:4,2), sp - - integer :: i, j, s, h1, h2, p1, p2, puti, putj - double precision :: hij, phase - double precision, external :: get_phase_bi, mo_bielec_integral - logical :: ok - - integer :: bant - bant = 1 - - - if(sp == 3) then ! AB - h1 = p(1,1) - h2 = p(1,2) - do p1=1, mo_tot_num - if(bannedOrb(p1, 1)) cycle - do p2=1, mo_tot_num - if(bannedOrb(p2,2)) cycle - if(banned(p1, p2, bant)) cycle ! rentable? - if(p1 == h1 .or. p2 == h2) then - call apply_particles(mask, 1,p1,2,p2, det, ok, N_int) - call i_h_j(gen, det, N_int, hij) - else - phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) - hij = mo_bielec_integral(p1, p2, h1, h2) * phase - end if - mat(:, p1, p2) += coefs(:) * hij - end do - end do - else ! AA BB - p1 = p(1,sp) - p2 = p(2,sp) - do puti=1, mo_tot_num - if(bannedOrb(puti, sp)) cycle - do putj=puti+1, mo_tot_num - if(bannedOrb(putj, sp)) cycle - if(banned(puti, putj, bant)) cycle ! rentable? - if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then - call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int) - call i_h_j(gen, det, N_int, hij) - else - hij = (mo_bielec_integral(p1, p2, puti, putj) - mo_bielec_integral(p2, p1, puti, putj))* get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2) - end if - mat(:, puti, putj) += coefs(:) * hij - end do - end do - end if -end - - subroutine past_d1(bannedOrb, p) use bitmasks implicit none @@ -1006,7 +1051,6 @@ subroutine past_d2(banned, p, sp) else do i=1,p(0, sp) do j=1,i-1 - if(p(j,sp) > p(i,sp)) stop "PPPPPPPP" banned(p(j,sp), p(i,sp)) = .true. banned(p(i,sp), p(j,sp)) = .true. end do @@ -1049,7 +1093,6 @@ subroutine count_d2(counted, p, sp) do i=1,p(0, sp) do j=1,i-1 counted(p(j,sp), p(i,sp)) += 1 - !counted(p(i,sp), p(j,sp)) += 1 end do end do end if @@ -1130,63 +1173,3 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint) end - -subroutine create_alpha_buffer(i_generator, sp, h1, h2, bannedOrb, banned, abuf, n) - use bitmasks - implicit none - - integer, intent(in) :: i_generator, sp, h1, h2 - logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num) - integer(bit_kind),intent(inout) :: abuf(N_int, 2, *) ! mo_tot_num**2 - integer, intent(out) :: n - logical :: ok - integer :: s1, s2, p1, p2, ib, j, istate - integer(bit_kind) :: mask(N_int, 2), det(N_int, 2) - - n = 0 - - if(sp == 3) then - s1 = 1 - s2 = 2 - else - s1 = sp - s2 = sp - end if - - call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int) - - do p1=1,mo_tot_num - if(bannedOrb(p1, s1)) cycle - ib = 1 - if(sp /= 3) ib = p1+1 - do p2=ib,mo_tot_num - if(bannedOrb(p2, s2)) cycle - if(banned(p1,p2)) cycle - n += 1 - call apply_particles(mask, s1, p1, s2, p2, abuf(1,1,n), ok, N_int) - if(.not. ok) stop "error in create_alpha_buffer" - end do - end do -end - - -double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2) - use bitmasks - implicit none - - integer, intent(in) :: phasemask(2,*) - integer, intent(in) :: s1, s2, h1, h2, p1, p2 - logical :: change - integer :: np1 - integer :: np - double precision, save :: res(0:1) = (/1d0, -1d0/) - - np1 = phasemask(s1,h1) + phasemask(s1,p1) + phasemask(s2,h2) + phasemask(s2,p2) - np = np1 - if(p1 < h1) np = np + 1 - if(p2 < h2) np = np + 1 - - if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1 - get_phase_bi = res(iand(np,1)) -end - diff --git a/plugins/mrcc_sto/mrcc_dress.irp.f b/plugins/mrcc_sto/mrcc_dress.irp.f index f51f5992..ca45a56e 100644 --- a/plugins/mrcc_sto/mrcc_dress.irp.f +++ b/plugins/mrcc_sto/mrcc_dress.irp.f @@ -13,22 +13,33 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, abuf, n_a implicit none double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) integer, intent(in) :: n_minilist, n_abuf - integer(bit_kind),intent(in) :: abuf(N_int, 2, n_abuf), minilist(N_int, 2, n_minilist) + integer(bit_kind),intent(in) :: abuf(N_int, 2, n_abuf) + integer :: minilist(n_minilist) integer :: a, i, nref, nobt, deg + integer :: refc(N_det), testc(N_det) do a=1,n_abuf - nref=0 + refc = 0 + testc = 0 do i=1,N_det - call get_excitation_degree(psi_det(1,1,i), abuf(1,1,a), deg, N_int) - if(deg <= 2) nref = nref + 1 + call get_excitation_degree(psi_det_sorted(1,1,i), abuf(1,1,a), deg, N_int) + if(deg <= 2) refc(i) = 1 end do - nobt=0 do i=1,n_minilist - call get_excitation_degree(minilist(1,1,i), abuf(1,1,a), deg, N_int) - if(deg <= 2) nobt = nobt + 1 + call get_excitation_degree(psi_det_sorted(1,1,minilist(i)), abuf(1,1,a), deg, N_int) + if(deg <= 2) then + testc(minilist(i)) = 1 + else + stop "NON LIKED" + end if + end do + + do i=1,N_det + if(refc(i) /= testc(i)) then + print *, "foir ", sum(refc), sum(testc), n_minilist + exit + end if end do - - if(nref /= nobt) stop "foireous minilist" end do delta_ij_loc = 1d0 From 5bd59241fa14d301dc142e27c5c3f25503065c2c Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 15 Feb 2018 14:07:20 +0100 Subject: [PATCH 28/65] removed duplicate determinants - questionable efficiency --- plugins/dress_zmq/alpha_factory.irp.f | 28 +++++++++++++++++++++++---- plugins/mrcc_sto/mrcc_dress.irp.f | 4 ++-- 2 files changed, 26 insertions(+), 6 deletions(-) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index 663bd380..957f8d69 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -366,11 +366,14 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe integer(bit_kind) :: alpha(N_int, 2, 1) integer, allocatable :: labuf(:) logical :: ok - integer :: i,j,s,st1,st2,st3,st4 + integer :: i,j,k,s,st1,st2,st3,st4 integer :: lindex(mo_tot_num,2), lindex_end(mo_tot_num, 2) integer :: s1, s2, stamo + logical,allocatable :: putten(:) + + allocate(labuf(N_det), putten(N_det)) + putten = .false. - allocate(labuf(N_det)) st1 = indexes_end(0,0) if(st1 > 0) labuf(:st1) = abuf(:st1) st1 += 1 @@ -403,6 +406,9 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe if(lindex(i,s1) /= 0) then st2 = st1 + 1 + lindex_end(i,s1)-lindex(i,s1) labuf(st1:st2-1) = abuf(lindex(i,s1):lindex_end(i,s1)) + do j=st1,st2-1 + putten(labuf(j)) = .true. + end do else st2 = st1 end if @@ -416,8 +422,15 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe do j=stamo,mo_tot_num if(bannedOrb(j,s2) .or. banned(i,j)) cycle if(lindex(j,s2) /= 0) then - st3 = st2 + 1 + lindex_end(j,s2)-lindex(j,s2) - labuf(st2:st3-1) = abuf(lindex(j,s2):lindex_end(j,s2)) + st3 = st2 + do k=lindex(j,s2), lindex_end(j,s2) + if(.not. putten(abuf(k))) then + labuf(st3) = abuf(k) + st3 += 1 + end if + end do + !st3 = st2 + 1 + lindex_end(j,s2)-lindex(j,s2) + !labuf(st2:st3-1) = abuf(lindex(j,s2):lindex_end(j,s2)) else st3 = st2 end if @@ -437,6 +450,13 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) end if end do + + if(lindex(i,s1) /= 0) then + do j=st1,st2-1 + putten(labuf(j)) = .false. + end do + end if + end do end subroutine diff --git a/plugins/mrcc_sto/mrcc_dress.irp.f b/plugins/mrcc_sto/mrcc_dress.irp.f index ca45a56e..bcc78c1b 100644 --- a/plugins/mrcc_sto/mrcc_dress.irp.f +++ b/plugins/mrcc_sto/mrcc_dress.irp.f @@ -23,12 +23,12 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, abuf, n_a testc = 0 do i=1,N_det call get_excitation_degree(psi_det_sorted(1,1,i), abuf(1,1,a), deg, N_int) - if(deg <= 2) refc(i) = 1 + if(deg <= 2) refc(i) = refc(i) + 1 end do do i=1,n_minilist call get_excitation_degree(psi_det_sorted(1,1,minilist(i)), abuf(1,1,a), deg, N_int) if(deg <= 2) then - testc(minilist(i)) = 1 + testc(minilist(i)) += 1 else stop "NON LIKED" end if From 95a1cddf4322b6495ec71dc24671c24d67d15386 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 16 Feb 2018 11:50:49 +0100 Subject: [PATCH 29/65] commented out computation of excitations --- plugins/dress_zmq/alpha_factory.irp.f | 163 ++++++++----------- plugins/dress_zmq/dress_stoch_routines.irp.f | 10 +- plugins/dress_zmq/run_dress_slave.irp.f | 17 +- plugins/mrcc_sto/mrcc_dress.irp.f | 48 ------ plugins/mrcc_sto/mrcc_sto.irp.f | 40 +++++ 5 files changed, 134 insertions(+), 144 deletions(-) delete mode 100644 plugins/mrcc_sto/mrcc_dress.irp.f diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index 957f8d69..a70c22ae 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -363,7 +363,7 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe integer, intent(in) :: indexes_end(0:mo_tot_num, 0:mo_tot_num), abuf(*) logical, intent(in) :: bannedOrb(mo_tot_num,2), banned(mo_tot_num, mo_tot_num) integer(bit_kind), intent(in) :: mask(N_int, 2) - integer(bit_kind) :: alpha(N_int, 2, 1) + integer(bit_kind) :: alpha(N_int, 2) integer, allocatable :: labuf(:) logical :: ok integer :: i,j,k,s,st1,st2,st3,st4 @@ -388,8 +388,6 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe else if(sp == 2) then s1 = 2 s2 = 2 - !lindex(:, 1) = indexes(0, 1:) - !lindex_end(:,1) = indexes_end(0, 1:) lindex(:, 2) = indexes(0, 1:) lindex_end(:, 2) = indexes_end(0, 1:) else if(sp == 1) then @@ -397,8 +395,6 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe s2 = 1 lindex(:, 1) = indexes(1:, 0) lindex_end(:,1) = indexes_end(1:, 0) - !lindex(:, 2) = indexes(1:, 0) - !lindex_end(:, 2) = indexes_end(1:, 0) end if do i=1,mo_tot_num @@ -443,10 +439,10 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe end if !APPLY PART if(st4 > 1) then - call apply_particles(mask, s1, i, s2, j, alpha(1,1,1), ok, N_int) - if(.not. ok) stop "non existing alpha......" + call apply_particles(mask, s1, i, s2, j, alpha, ok, N_int) + !if(.not. ok) stop "non existing alpha......" !print *, "willcall", st4-1, size(labuf) - call dress_with_alpha_buffer(delta_ij_loc, labuf, st4-1, alpha, 1) + call dress_with_alpha_buffer(delta_ij_loc, labuf, st4-1, alpha) !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) end if end do @@ -670,7 +666,6 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, indexes, ab else if(nt == 3) then call get_d1(interesting(i), det(1,1,i), banned, bannedOrb, indexes, abuf, mask, h, p, sp) else - if(abuf(indexes(0,0)) /= 0) stop "noz" abuf(indexes(0,0)) = interesting(i) indexes(0,0) += 1 end if @@ -720,39 +715,36 @@ subroutine get_d2(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) do i = 1, 3 putj = p(i, ma) if(banned(putj,puti,bant)) cycle - i1 = turn3(1,i) - i2 = turn3(2,i) - p1 = p(i1, ma) - p2 = p(i2, ma) - h1 = h(1, ma) - h2 = h(2, ma) + !i1 = turn3(1,i) + !i2 = turn3(2,i) + !p1 = p(i1, ma) + !p2 = p(i2, ma) + !h1 = h(1, ma) + !h2 = h(2, ma) !hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) if(ma == 1) then - if(abuf(indexes(putj,puti)) /= 0) stop "noz" abuf(indexes(putj, puti)) = i_gen indexes(putj, puti) += 1 else - if(abuf(indexes(puti,putj)) /= 0) stop "noz" abuf(indexes(puti, putj)) = i_gen indexes(puti, putj) += 1 end if end do else - h1 = h(1,1) - h2 = h(1,2) + !h1 = h(1,1) + !h2 = h(1,2) do j = 1,2 putj = p(j, 2) - p2 = p(turn2(j), 2) + !p2 = p(turn2(j), 2) do i = 1,2 puti = p(i, 1) if(banned(puti,putj,bant)) cycle - p1 = p(turn2(i), 1) + !p1 = p(turn2(i), 1) !hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) - if(abuf(indexes(puti,putj)) /= 0) stop "noz" abuf(indexes(puti, putj)) = i_gen indexes(puti, putj) += 1 end do @@ -761,36 +753,34 @@ subroutine get_d2(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) else if(tip == 0) then - h1 = h(1, ma) - h2 = h(2, ma) + !h1 = h(1, ma) + !h2 = h(2, ma) do i=1,3 puti = p(i, ma) do j=i+1,4 putj = p(j, ma) if(banned(puti,putj,1)) cycle - i1 = turn2d(1, i, j) - i2 = turn2d(2, i, j) - p1 = p(i1, ma) - p2 = p(i2, ma) + !i1 = turn2d(1, i, j) + !i2 = turn2d(2, i, j) + !p1 = p(i1, ma) + !p2 = p(i2, ma) !hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) - if(abuf(indexes(puti,putj)) /= 0) stop "noz" abuf(indexes(puti, putj)) = i_gen indexes(puti, putj) += 1 end do end do else if(tip == 3) then - h1 = h(1, mi) - h2 = h(1, ma) - p1 = p(1, mi) + !h1 = h(1, mi) + !h2 = h(1, ma) + !p1 = p(1, mi) do i=1,3 puti = p(turn3(1,i), ma) putj = p(turn3(2,i), ma) if(banned(puti,putj,1)) cycle - p2 = p(i, ma) + !p2 = p(i, ma) !hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2) - if(abuf(indexes( min(puti, putj), max(puti, putj)) ) /= 0) stop "noz" abuf(indexes(min(puti, putj), max(puti, putj))) = i_gen indexes(min(puti, putj), max(puti, putj)) += 1 end do @@ -798,13 +788,12 @@ subroutine get_d2(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) puti = p(1, sp) putj = p(2, sp) if(.not. banned(puti,putj,1)) then - p1 = p(1, mi) - p2 = p(2, mi) - h1 = h(1, mi) - h2 = h(2, mi) + !p1 = p(1, mi) + !p2 = p(2, mi) + !h1 = h(1, mi) + !h2 = h(2, mi) !hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2) - if(abuf(indexes(puti,putj)) /= 0) stop "noz" abuf(indexes(puti, putj)) = i_gen indexes(puti, putj) += 1 end if @@ -818,7 +807,7 @@ subroutine get_d1(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) implicit none integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) - integer, intent(inout) :: abuf(*) + integer, intent(inout) :: abuf(*) integer,intent(in) :: i_gen logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) integer(bit_kind) :: det(N_int, 2) @@ -878,13 +867,11 @@ subroutine get_d1(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) if(ma == 1) then !mat(1:N_states,1:mo_tot_num,puti) += tmp_row(1:N_states,1:mo_tot_num) - if(abuf(indexes(0,puti)) /= 0) stop "noz" abuf(indexes(0, puti)) = i_gen indexes(0, puti) += 1 !countedOrb(puti, 2) -= 1 else !mat(1:N_states,puti,1:mo_tot_num) += tmp_row(1:N_states,1:mo_tot_num) - if(abuf(indexes(puti,0)) /= 0) stop "noz" abuf(indexes(puti, 0)) = i_gen indexes(puti, 0) += 1 !countedOrb(puti, 1) -= 1 @@ -892,44 +879,40 @@ subroutine get_d1(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) end if !MOVE MI - pfix = p(1,mi) - tmp_row = 0d0 - tmp_row2 = 0d0 - do puti=1,mo_tot_num - if(lbanned(puti,mi)) cycle + !pfix = p(1,mi) + !tmp_row = 0d0 + !tmp_row2 = 0d0 + !do puti=1,mo_tot_num + ! if(lbanned(puti,mi)) cycle !p1 fixed - putj = p1 + ! putj = p1 !if(.not. banned(putj,puti,bant)) then ! hij = mo_bielec_integral(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix) ! tmp_row(:,puti) += hij * coefs(:) !end if - putj = p2 + ! putj = p2 !if(.not. banned(putj,puti,bant)) then ! hij = mo_bielec_integral(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix) ! tmp_row2(:,puti) += hij * coefs(:) !end if - end do + !end do if(mi == 1) then if(.not. bannedOrb(p1, 2)) then - if(abuf(indexes(0,p1)) /= 0) stop "noz" abuf(indexes(0,p1)) = i_gen indexes(0,p1) += 1 end if if(.not. bannedOrb(p2, 2)) then - if(abuf(indexes(0,p2)) /= 0) stop "noz" abuf(indexes(0,p2)) = i_gen indexes(0,p2) += 1 end if else if(.not. bannedOrb(p1, 1)) then - if(abuf(indexes(p1,0)) /= 0) stop "noz" abuf(indexes(p1,0)) = i_gen indexes(p1,0) += 1 end if if(.not. bannedOrb(p2, 1)) then - if(abuf(indexes(p2,0)) /= 0) stop "noz" abuf(indexes(p2,0)) = i_gen indexes(p2,0) += 1 end if @@ -937,10 +920,10 @@ subroutine get_d1(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) else if(p(0,ma) == 3) then do i=1,3 - hfix = h(1,ma) + !hfix = h(1,ma) puti = p(i, ma) - p1 = p(turn3(1,i), ma) - p2 = p(turn3(2,i), ma) + !p1 = p(turn3(1,i), ma) + !p2 = p(turn3(2,i), ma) !tmp_row = 0d0 !do putj=1,hfix-1 ! if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle @@ -957,55 +940,49 @@ subroutine get_d1(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) !mat(:, puti, puti:) += tmp_row(:,puti:) if(.not. bannedOrb(puti, sp)) then if(sp == 1) then - if(abuf(indexes(puti,0)) /= 0) stop "noz" abuf(indexes(puti, 0)) = i_gen indexes(puti, 0) += 1 else - if(abuf(indexes(0,puti)) /= 0) stop "noz" abuf(indexes(0, puti)) = i_gen indexes(0, puti) += 1 end if end if end do else - hfix = h(1,mi) - pfix = p(1,mi) + !hfix = h(1,mi) + !pfix = p(1,mi) p1 = p(1,ma) p2 = p(2,ma) - tmp_row = 0d0 - tmp_row2 = 0d0 - do puti=1,mo_tot_num - if(lbanned(puti,ma)) cycle - putj = p2 + !tmp_row = 0d0 + !tmp_row2 = 0d0 + !do puti=1,mo_tot_num + ! if(lbanned(puti,ma)) cycle + ! putj = p2 !if(.not. banned(puti,putj,1)) then ! hij = mo_bielec_integral(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1) ! tmp_row(:,puti) += hij * coefs(:) !end if - putj = p1 + ! putj = p1 !if(.not. banned(puti,putj,1)) then ! hij = mo_bielec_integral(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2) ! tmp_row2(:,puti) += hij * coefs(:) !end if - end do + !end do if(.not. bannedOrb(p2, sp)) then if(sp == 1) then - if(abuf(indexes(p2,0)) /= 0) stop "noz" abuf(indexes(p2, 0)) = i_gen indexes(p2, 0) += 1 else - if(abuf(indexes(0,p2)) /= 0) stop "noz" abuf(indexes(0, p2)) = i_gen indexes(0, p2) += 1 end if end if if(.not. bannedOrb(p1, sp)) then if(sp == 1) then - if(abuf(indexes(p1,0)) /= 0) stop "noz" abuf(indexes(p1, 0)) = i_gen indexes(p1, 0) += 1 else - if(abuf(indexes(0,p1)) /= 0) stop "noz" abuf(indexes(0, p1)) = i_gen indexes(0, p1) += 1 end if @@ -1014,27 +991,27 @@ subroutine get_d1(i_gen, gen, banned, bannedOrb, indexes, abuf, mask, h, p, sp) end if !! MONO - if(sp == 3) then - s1 = 1 - s2 = 2 - else - s1 = sp - s2 = sp - end if - - do i1=1,p(0,s1) - ib = 1 - if(s1 == s2) ib = i1+1 - do i2=ib,p(0,s2) - p1 = p(i1,s1) - p2 = p(i2,s2) - if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle - call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) - call i_h_j(gen, det, N_int, hij) - !mat(:, p1, p2) += coefs(:) * hij - !!!!!!!! DUPLICTATE counted(p1, p2) !!!!!!!!!!!!!!!!!!!! - end do - end do + ! if(sp == 3) then + ! s1 = 1 + ! s2 = 2 + ! else + ! s1 = sp + ! s2 = sp + ! end if +! +! do i1=1,p(0,s1) +! ib = 1 +! if(s1 == s2) ib = i1+1 +! do i2=ib,p(0,s2) +! p1 = p(i1,s1) +! p2 = p(i2,s2) + ! if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle + ! call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) +! call i_h_j(gen, det, N_int, hij) +! !mat(:, p1, p2) += coefs(:) * hij +! !!!!!!!! DUPLICTATE counted(p1, p2) !!!!!!!!!!!!!!!!!!!! +! end do +! end do end diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 8dcc6ade..29ca80f7 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -193,7 +193,15 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, pullLoop : do while (loop) call pull_dress_results(zmq_socket_pull, ind, delta_loc, task_id) - dress_mwen(:) = 0d0 !!!!!!!! A CALCULER ICI + dress_mwen(:) = 0d0 + + !!!!! A VERIFIER !!!!! + do i_state=1,N_states + do i=1, N_det + dress_mwen(i_state) += delta_loc(i_state, i, 1) * psi_coef(i, i_state) + end do + end do + dress_detail(:, ind) += dress_mwen(:) do j=1,N_cp !! optimizable if(cps(ind, j) > 0d0) then diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index b561cec3..906bfcb3 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -29,8 +29,9 @@ subroutine run_dress_slave(thread,iproc,energy) double precision,allocatable :: dress_detail(:) integer :: ind - double precision,allocatable :: delta_ij_loc(:,:,:) - integer :: h,p,n + double precision,allocatable :: delta_ij_loc(:,:,:) + double precision :: div(N_states) + integer :: h,p,n,i_state logical :: ok allocate(delta_ij_loc(N_states,N_det,2)) @@ -44,6 +45,9 @@ subroutine run_dress_slave(thread,iproc,energy) call end_zmq_push_socket(zmq_socket_push,thread) return end if + do i=1,N_states + div(i) = psi_ref_coef(dressed_column_idx(i), i) + end do do call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) @@ -51,6 +55,15 @@ subroutine run_dress_slave(thread,iproc,energy) read (task,*) subset, i_generator delta_ij_loc = 0d0 call alpha_callback(delta_ij_loc, i_generator, subset) + + !!! SET DRESSING COLUMN? + do i=1,N_det + do i_state=1,N_states + delta_ij_loc(i_state,i,1) = delta_ij_loc(i_state,i,1) / div(i_state) + delta_ij_loc(i_state,i,2) = delta_ij_loc(i_state,i,2) / div(i_state) + end do + end do + call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) call push_dress_results(zmq_socket_push, i_generator, delta_ij_loc, task_id) else diff --git a/plugins/mrcc_sto/mrcc_dress.irp.f b/plugins/mrcc_sto/mrcc_dress.irp.f deleted file mode 100644 index bcc78c1b..00000000 --- a/plugins/mrcc_sto/mrcc_dress.irp.f +++ /dev/null @@ -1,48 +0,0 @@ - -! BEGIN_PROVIDER [ logical, do_dress_with_alpha ] -!&BEGIN_PROVIDER [ logical, do_dress_with_alpha_buffer ] -!&BEGIN_PROVIDER [ logical, do_dress_with_generator ] -! implicit none -! do_dress_with_alpha = .false. -! do_dress_with_alpha_buffer = .true. -! do_dress_with_generator = .false. -!END_PROVIDER - -subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, abuf, n_abuf) - use bitmasks - implicit none - double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) - integer, intent(in) :: n_minilist, n_abuf - integer(bit_kind),intent(in) :: abuf(N_int, 2, n_abuf) - integer :: minilist(n_minilist) - integer :: a, i, nref, nobt, deg - integer :: refc(N_det), testc(N_det) - - do a=1,n_abuf - refc = 0 - testc = 0 - do i=1,N_det - call get_excitation_degree(psi_det_sorted(1,1,i), abuf(1,1,a), deg, N_int) - if(deg <= 2) refc(i) = refc(i) + 1 - end do - do i=1,n_minilist - call get_excitation_degree(psi_det_sorted(1,1,minilist(i)), abuf(1,1,a), deg, N_int) - if(deg <= 2) then - testc(minilist(i)) += 1 - else - stop "NON LIKED" - end if - end do - - do i=1,N_det - if(refc(i) /= testc(i)) then - print *, "foir ", sum(refc), sum(testc), n_minilist - exit - end if - end do - end do - - delta_ij_loc = 1d0 -end subroutine - - diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index 173d8d26..a47b0a5b 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -12,3 +12,43 @@ program mrcc_sto print *, "========================" call dress_zmq() end + + + +!! TESTS MINILIST +subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) + use bitmasks + implicit none + double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) + integer, intent(in) :: n_minilist + integer(bit_kind),intent(in) :: alpha(N_int, 2) + integer, intent(in) :: minilist(n_minilist) + integer :: a, i, deg + integer :: refc(N_det), testc(N_det) + + refc = 0 + testc = 0 + do i=1,N_det + call get_excitation_degree(psi_det_sorted(1,1,i), alpha, deg, N_int) + if(deg <= 2) refc(i) = refc(i) + 1 + end do + do i=1,n_minilist + call get_excitation_degree(psi_det_sorted(1,1,minilist(i)), alpha, deg, N_int) + if(deg <= 2) then + testc(minilist(i)) += 1 + else + stop "NON LINKED IN MINILIST" + end if + end do + + do i=1,N_det + if(refc(i) /= testc(i)) then + print *, "MINILIST FAIL ", sum(refc), sum(testc), n_minilist + exit + end if + end do + + delta_ij_loc = 0d0 +end subroutine + + From 218f39770cfb111b073f2be78b2860939a8d68de Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Feb 2018 17:26:34 +0100 Subject: [PATCH 30/65] Cleaning --- plugins/mrcepa0/dressing.irp.f | 607 ++++-------------- plugins/mrcepa0/dressing_vector.irp.f | 4 +- plugins/mrcepa0/run_mrcc_slave.irp.f | 2 +- .../DavidsonDressed/NEEDED_CHILDREN_MODULES | 0 {plugins => src}/DavidsonDressed/README.rst | 0 .../DavidsonDressed/diagonalize_CI.irp.f | 0 .../diagonalization_hs2_dressed.irp.f | 2 +- 7 files changed, 139 insertions(+), 476 deletions(-) rename {plugins => src}/DavidsonDressed/NEEDED_CHILDREN_MODULES (100%) rename {plugins => src}/DavidsonDressed/README.rst (100%) rename {plugins => src}/DavidsonDressed/diagonalize_CI.irp.f (100%) diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 951c8c4c..4c7502ec 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -74,117 +74,117 @@ BEGIN_PROVIDER [ double precision, mrcc_norm_acc, (0:N_det_non_ref, N_states) ] END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_ij_mrcc_sto,(N_states,N_det_non_ref) ] -&BEGIN_PROVIDER [ double precision, delta_ij_s2_mrcc_sto, (N_states,N_det_non_ref) ] - use bitmasks - implicit none - integer :: gen, h, p, n, t, i, j, h1, h2, p1, p2, s1, s2, iproc - integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2) - integer(bit_kind),allocatable :: buf(:,:,:) - logical :: ok - logical, external :: detEq - integer, external :: omp_get_thread_num - double precision :: coefs(N_det_non_ref), myCoef - integer :: n_in_teeth - double precision :: contrib(N_states), curn, in_teeth_step, curlim, curnorm - - contrib = 0d0 - read(*,*) n_in_teeth - !n_in_teeth = 2 - in_teeth_step = 1d0 / dfloat(n_in_teeth) - !double precision :: delta_ij_mrcc_tmp,(N_states,N_det_non_ref) - !double precision :: delta_ij_s2_mrcc_tmp(N_states,N_det_non_ref) - - coefs = 0d0 - coefs(:mrcc_teeth(1,1)-1) = 1d0 - - do i=1,N_mrcc_teeth - print *, "TEETH SIZE", i, mrcc_teeth(i+1,1)-mrcc_teeth(i,1) - if(mrcc_teeth(i+1,1) - mrcc_teeth(i,1) <= n_in_teeth) then - coefs(mrcc_teeth(i,1):mrcc_teeth(i+1,1)-1) = 1d0 - else if(.false.) then - curnorm = 0d0 - curn = 0.5d0 - curlim = curn / dfloat(n_in_teeth) - do j=mrcc_teeth(i,1), mrcc_teeth(i+1,1)-1 - if(mrcc_norm_acc(j,1) >= curlim) then - coefs(j) = 1d0 - curnorm += mrcc_norm(j,1) - do while(mrcc_norm_acc(j,1) > curlim) - curn += 1d0 - curlim = curn / dfloat(n_in_teeth) - end do - end if - end do - do j=mrcc_teeth(i,1), mrcc_teeth(i+1,1)-1 - coefs(j) = coefs(j) / curnorm ! 1d0 / norm computed in teeth - end do - else if(.true.) then - coefs(mrcc_teeth(i,1):mrcc_teeth(i,1)+n_in_teeth-1) = 1d0 / mrcc_norm_acc(mrcc_teeth(i,1)+n_in_teeth-1, 1) - else - curnorm = 0d0 - n = mrcc_teeth(i+1,1) - mrcc_teeth(i,1) - do j=1,n_in_teeth - t = int((dfloat(j)-0.5d0) * dfloat(n) / dfloat(n_in_teeth)) + 1 + mrcc_teeth(i,1) - 1 - curnorm += mrcc_norm(t,1) - coefs(t) = 1d0 - end do - do j=mrcc_teeth(i,1), mrcc_teeth(i+1,1)-1 - coefs(j) = coefs(j) / curnorm ! 1d0 / norm computed in teeth - end do - end if - !coefs(mrcc_teeth(i,1)) = - end do - - !coefs = coefs * dfloat(N_det_generators) - - - delta_ij_mrcc_sto = 0d0 - delta_ij_s2_mrcc_sto = 0d0 - PROVIDE dij - provide hh_shortcut psi_det_size! lambda_mrcc - !$OMP PARALLEL DO default(none) schedule(dynamic) & - !$OMP shared(psi_ref, psi_non_ref, hh_exists, pp_exists, N_int, hh_shortcut) & - !$OMP shared(N_det_generators, coefs,N_det_non_ref, delta_ij_mrcc_sto) & - !$OMP shared(contrib,psi_det_generators, delta_ij_s2_mrcc_sto) & - !$OMP private(i,j,curnorm,myCoef, h, n, mask, omask, buf, ok, iproc) - do gen= 1,N_det_generators - if(coefs(gen) == 0d0) cycle - myCoef = coefs(gen) - allocate(buf(N_int, 2, N_det_non_ref)) - iproc = omp_get_thread_num() + 1 - if(mod(gen, 1000) == 0) print *, "mrcc_sto ", gen, "/", N_det_generators - - do h=1, hh_shortcut(0) - call apply_hole_local(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int) - if(.not. ok) cycle - omask = 0_bit_kind - if(hh_exists(1, h) /= 0) omask = mask - n = 1 - do p=hh_shortcut(h), hh_shortcut(h+1)-1 - call apply_particle_local(mask, pp_exists(1, p), buf(1,1,n), ok, N_int) - if(ok) n = n + 1 - if(n > N_det_non_ref) stop "Buffer too small in MRCC..." - end do - n = n - 1 - if(n /= 0) then - call mrcc_part_dress(delta_ij_mrcc_sto, delta_ij_s2_mrcc_sto, & - gen,n,buf,N_int,omask,myCoef,contrib) - endif - end do - deallocate(buf) - end do - !$OMP END PARALLEL DO - - - - curnorm = 0d0 - do j=1,N_det_non_ref - curnorm += delta_ij_mrcc_sto(1,j)*delta_ij_mrcc_sto(1,j) - end do - print *, "NORM DELTA ", dsqrt(curnorm) - -END_PROVIDER +! BEGIN_PROVIDER [ double precision, delta_ij_mrcc_sto,(N_states,N_det_non_ref) ] +!&BEGIN_PROVIDER [ double precision, delta_ij_s2_mrcc_sto, (N_states,N_det_non_ref) ] +! use bitmasks +! implicit none +! integer :: gen, h, p, n, t, i, j, h1, h2, p1, p2, s1, s2, iproc +! integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2) +! integer(bit_kind),allocatable :: buf(:,:,:) +! logical :: ok +! logical, external :: detEq +! integer, external :: omp_get_thread_num +! double precision :: coefs(N_det_non_ref), myCoef +! integer :: n_in_teeth +! double precision :: contrib(N_states), curn, in_teeth_step, curlim, curnorm +! +! contrib = 0d0 +! read(*,*) n_in_teeth +! !n_in_teeth = 2 +! in_teeth_step = 1d0 / dfloat(n_in_teeth) +! !double precision :: delta_ij_mrcc_tmp,(N_states,N_det_non_ref) +! !double precision :: delta_ij_s2_mrcc_tmp(N_states,N_det_non_ref) +! +! coefs = 0d0 +! coefs(:mrcc_teeth(1,1)-1) = 1d0 +! +! do i=1,N_mrcc_teeth +! print *, "TEETH SIZE", i, mrcc_teeth(i+1,1)-mrcc_teeth(i,1) +! if(mrcc_teeth(i+1,1) - mrcc_teeth(i,1) <= n_in_teeth) then +! coefs(mrcc_teeth(i,1):mrcc_teeth(i+1,1)-1) = 1d0 +! else if(.false.) then +! curnorm = 0d0 +! curn = 0.5d0 +! curlim = curn / dfloat(n_in_teeth) +! do j=mrcc_teeth(i,1), mrcc_teeth(i+1,1)-1 +! if(mrcc_norm_acc(j,1) >= curlim) then +! coefs(j) = 1d0 +! curnorm += mrcc_norm(j,1) +! do while(mrcc_norm_acc(j,1) > curlim) +! curn += 1d0 +! curlim = curn / dfloat(n_in_teeth) +! end do +! end if +! end do +! do j=mrcc_teeth(i,1), mrcc_teeth(i+1,1)-1 +! coefs(j) = coefs(j) / curnorm ! 1d0 / norm computed in teeth +! end do +! else if(.true.) then +! coefs(mrcc_teeth(i,1):mrcc_teeth(i,1)+n_in_teeth-1) = 1d0 / mrcc_norm_acc(mrcc_teeth(i,1)+n_in_teeth-1, 1) +! else +! curnorm = 0d0 +! n = mrcc_teeth(i+1,1) - mrcc_teeth(i,1) +! do j=1,n_in_teeth +! t = int((dfloat(j)-0.5d0) * dfloat(n) / dfloat(n_in_teeth)) + 1 + mrcc_teeth(i,1) - 1 +! curnorm += mrcc_norm(t,1) +! coefs(t) = 1d0 +! end do +! do j=mrcc_teeth(i,1), mrcc_teeth(i+1,1)-1 +! coefs(j) = coefs(j) / curnorm ! 1d0 / norm computed in teeth +! end do +! end if +! !coefs(mrcc_teeth(i,1)) = +! end do +! +! !coefs = coefs * dfloat(N_det_generators) +! +! +! delta_ij_mrcc_sto = 0d0 +! delta_ij_s2_mrcc_sto = 0d0 +! PROVIDE dij +! provide hh_shortcut psi_det_size! lambda_mrcc +! !$OMP PARALLEL DO default(none) schedule(dynamic) & +! !$OMP shared(psi_ref, psi_non_ref, hh_exists, pp_exists, N_int, hh_shortcut) & +! !$OMP shared(N_det_generators, coefs,N_det_non_ref, delta_ij_mrcc_sto) & +! !$OMP shared(contrib,psi_det_generators, delta_ij_s2_mrcc_sto) & +! !$OMP private(i,j,curnorm,myCoef, h, n, mask, omask, buf, ok, iproc) +! do gen= 1,N_det_generators +! if(coefs(gen) == 0d0) cycle +! myCoef = coefs(gen) +! allocate(buf(N_int, 2, N_det_non_ref)) +! iproc = omp_get_thread_num() + 1 +! if(mod(gen, 1000) == 0) print *, "mrcc_sto ", gen, "/", N_det_generators +! +! do h=1, hh_shortcut(0) +! call apply_hole_local(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int) +! if(.not. ok) cycle +! omask = 0_bit_kind +! if(hh_exists(1, h) /= 0) omask = mask +! n = 1 +! do p=hh_shortcut(h), hh_shortcut(h+1)-1 +! call apply_particle_local(mask, pp_exists(1, p), buf(1,1,n), ok, N_int) +! if(ok) n = n + 1 +! if(n > N_det_non_ref) stop "Buffer too small in MRCC..." +! end do +! n = n - 1 +! if(n /= 0) then +! call mrcc_part_dress(delta_ij_mrcc_sto, delta_ij_s2_mrcc_sto, & +! gen,n,buf,N_int,omask,myCoef,contrib) +! endif +! end do +! deallocate(buf) +! end do +! !$OMP END PARALLEL DO +! +! +! +! curnorm = 0d0 +! do j=1,N_det_non_ref +! curnorm += delta_ij_mrcc_sto(1,j)*delta_ij_mrcc_sto(1,j) +! end do +! print *, "NORM DELTA ", dsqrt(curnorm) +! +!END_PROVIDER @@ -206,19 +206,15 @@ END_PROVIDER integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2),inac, virt integer, external :: get_index_in_psi_det_sorted_bit, searchDet,detCmp logical, external :: is_in_wavefunction - double precision :: c0(N_states) provide dij delta_ij_cancel = 0d0 - do i_state = 1, N_states - c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) - enddo do i=1,N_det_ref !$OMP PARALLEL DO default(shared) private(kk, k, blok, exc_Ik,det_tmp2,ok,deg,phase_Ik, l,ll) & - !$OMP private(contrib, contrib_s2, i_state, c0) + !$OMP private(contrib, contrib_s2, i_state) do kk = 1, nlink(i) k = det_cepa0_idx(linked(kk, i)) blok = blokMwen(kk, i) @@ -239,9 +235,9 @@ END_PROVIDER contrib = (dij(j, l, i_state) - dij(i, k, i_state)) * delta_cas(i,j,i_state)! * Hla *phase_ia * phase_ik contrib_s2 = dij(j, l, i_state) - dij(i, k, i_state)! * Sla*phase_ia * phase_ik !$OMP ATOMIC - delta_ij_cancel(i_state,l) += contrib * psi_ref_coef(i,i_state) * c0(i_state) + delta_ij_cancel(i_state,l) += contrib * psi_ref_coef(i,i_state) !$OMP ATOMIC - delta_ij_s2_cancel(i_state,l) += contrib_s2* psi_ref_coef(i,i_state) * c0(i_state) + delta_ij_s2_cancel(i_state,l) += contrib_s2* psi_ref_coef(i,i_state) end do end do end do @@ -292,7 +288,7 @@ END_PROVIDER n = n - 1 if(n /= 0) then - call mrcc_part_dress(delta_ij_mrcc, delta_ij_s2_mrcc, gen,n,buf,N_int,omask,1d0,contrib) + call mrcc_part_dress(delta_ij_mrcc, delta_ij_s2_mrcc, gen,n,buf,N_int,omask,contrib) endif end do @@ -308,7 +304,7 @@ END_PROVIDER ! end subroutine -subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_buffer,Nint,key_mask,coef,contrib) +subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_buffer,Nint,key_mask,contrib) use bitmasks implicit none @@ -346,7 +342,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b logical, external :: detEq, is_generable !double precision, external :: get_dij, get_dij_index double precision :: Delta_E_inv(N_states) - double precision, intent(in) :: coef double precision, intent(inout) :: contrib(N_states) double precision :: sdress, hdress @@ -376,11 +371,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b deallocate(microlist, idx_microlist) - double precision :: c0(N_states) - do i_state=1,N_states - c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) - enddo - allocate (dIa_hla(N_states,N_det_non_ref), dIa_sla(N_states,N_det_non_ref)) ! |I> @@ -546,15 +536,15 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b hla = hij_cache(k_sd) sla = sij_cache(k_sd) do i_state=1,N_states - dIa_hla(i_state,k_sd) = dIa(i_state) * hla * coef - dIa_sla(i_state,k_sd) = dIa(i_state) * sla * coef + dIa_hla(i_state,k_sd) = dIa(i_state) * hla + dIa_sla(i_state,k_sd) = dIa(i_state) * sla enddo enddo do i_state=1,N_states do l_sd=1,idx_alpha(0) k_sd = idx_alpha(l_sd) - hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) - sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) + hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) + sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) !$OMP ATOMIC contrib(i_state) += hdress * psi_coef(dressed_column_idx(i_state), i_state) * psi_non_ref_coef(k_sd, i_state) !$OMP ATOMIC @@ -570,275 +560,13 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b end - -subroutine mrcc_part_dress_1c(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_buffer,Nint,key_mask,contrib) - use bitmasks - implicit none - - integer, intent(in) :: i_generator,n_selected, Nint - double precision, intent(inout) :: delta_ij_(N_states,N_det_non_ref) - double precision, intent(inout) :: delta_ij_s2_(N_states,N_det_non_ref) - - integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) - integer :: i,j,k,l,m - integer,allocatable :: idx_alpha(:), degree_alpha(:) - logical :: good, fullMatch - - integer(bit_kind),allocatable :: tq(:,:,:) - integer :: N_tq, c_ref ,degree1, degree2, degree - - double precision :: hIk, hla, hIl, sla, dIk(N_states), dka(N_states), dIa(N_states), hka - double precision, allocatable :: dIa_hla(:,:), dIa_sla(:,:) - double precision :: haj, phase, phase2 - double precision :: f(N_states), ci_inv(N_states) - integer :: exc(0:2,2,2) - integer :: h1,h2,p1,p2,s1,s2 - integer(bit_kind) :: tmp_det(Nint,2) - integer :: iint, ipos - integer :: i_state, k_sd, l_sd, i_I, i_alpha - - integer(bit_kind),allocatable :: miniList(:,:,:) - integer(bit_kind),intent(in) :: key_mask(Nint, 2) - integer,allocatable :: idx_miniList(:) - integer :: N_miniList, ni, leng - double precision, allocatable :: hij_cache(:), sij_cache(:) - - integer(bit_kind), allocatable :: microlist(:,:,:), microlist_zero(:,:,:) - integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) - integer :: mobiles(2), smallerlist - logical, external :: detEq, is_generable - !double precision, external :: get_dij, get_dij_index - double precision :: Delta_E_inv(N_states) - double precision, intent(inout) :: contrib(N_states) - double precision :: sdress, hdress - - if (perturbative_triples) then - PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat - endif - - - leng = max(N_det_generators, N_det_non_ref) - allocate(miniList(Nint, 2, leng), tq(Nint,2,n_selected), idx_minilist(leng), hij_cache(N_det_non_ref), sij_cache(N_det_non_ref)) - allocate(idx_alpha(0:psi_det_size), degree_alpha(psi_det_size)) - call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint) - - allocate(ptr_microlist(0:mo_tot_num*2+1), & - N_microlist(0:mo_tot_num*2) ) - allocate( microlist(Nint,2,N_minilist*4), & - idx_microlist(N_minilist*4)) - - if(key_mask(1,1) /= 0) then - call create_microlist(miniList, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) - call filter_tq_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microlist,ptr_microlist,N_microlist,key_mask) - else - call filter_tq(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_minilist) - end if - - - - deallocate(microlist, idx_microlist) - - allocate (dIa_hla(N_states,N_det_non_ref), dIa_sla(N_states,N_det_non_ref)) - - ! |I> - - ! |alpha> - - if(N_tq > 0) then - call create_minilist(key_mask, psi_non_ref, miniList, idx_minilist, N_det_non_ref, N_minilist, Nint) - if(N_minilist == 0) return - - - if(sum(abs(key_mask(1:N_int,1))) /= 0) then - allocate(microlist_zero(Nint,2,N_minilist), idx_microlist_zero(N_minilist)) - - allocate( microlist(Nint,2,N_minilist*4), & - idx_microlist(N_minilist*4)) - call create_microlist(miniList, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) - - - do i=0,mo_tot_num*2 - do k=ptr_microlist(i),ptr_microlist(i+1)-1 - idx_microlist(k) = idx_minilist(idx_microlist(k)) - end do - end do - - do l=1,N_microlist(0) - do k=1,Nint - microlist_zero(k,1,l) = microlist(k,1,l) - microlist_zero(k,2,l) = microlist(k,2,l) - enddo - idx_microlist_zero(l) = idx_microlist(l) - enddo - end if - end if - - double precision :: c0(N_states) - do i_state=1,N_states - c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) - enddo - - - do i_alpha=1,N_tq - if(key_mask(1,1) /= 0) then - call getMobiles(tq(1,1,i_alpha), key_mask, mobiles, Nint) - - if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then - smallerlist = mobiles(1) - else - smallerlist = mobiles(2) - end if - - - do l=0,N_microlist(smallerlist)-1 - microlist_zero(:,:,ptr_microlist(1) + l) = microlist(:,:,ptr_microlist(smallerlist) + l) - idx_microlist_zero(ptr_microlist(1) + l) = idx_microlist(ptr_microlist(smallerlist) + l) - end do - - call get_excitation_degree_vector(microlist_zero,tq(1,1,i_alpha),degree_alpha,Nint,N_microlist(smallerlist)+N_microlist(0),idx_alpha) - do j=1,idx_alpha(0) - idx_alpha(j) = idx_microlist_zero(idx_alpha(j)) - end do - - else - call get_excitation_degree_vector(miniList,tq(1,1,i_alpha),degree_alpha,Nint,N_minilist,idx_alpha) - do j=1,idx_alpha(0) - idx_alpha(j) = idx_miniList(idx_alpha(j)) - end do - end if - - do l_sd=1,idx_alpha(0) - k_sd = idx_alpha(l_sd) - call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hij_cache(k_sd)) - call get_s2(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,sij_cache(k_sd)) - !if(sij_cache(k_sd) /= 0D0) PRINT *, "SIJ ", sij_cache(k_sd) - enddo - - ! |I> - do i_I=1,N_det_ref - ! Find triples and quadruple grand parents - call get_excitation_degree(tq(1,1,i_alpha),psi_ref(1,1,i_I),degree1,Nint) - if (degree1 > 4) then - cycle - endif - - do i_state=1,N_states - dIa(i_state) = 0.d0 - enddo - - ! |alpha> - do k_sd=1,idx_alpha(0) - - call get_excitation_degree(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(k_sd)),degree,Nint) - if (degree > 2) then - cycle - endif - - ! - - ! |l> = Exc(k -> alpha) |I> - call get_excitation(psi_non_ref(1,1,idx_alpha(k_sd)),tq(1,1,i_alpha),exc,degree2,phase,Nint) - call decode_exc(exc,degree2,h1,p1,h2,p2,s1,s2) - do k=1,N_int - tmp_det(k,1) = psi_ref(k,1,i_I) - tmp_det(k,2) = psi_ref(k,2,i_I) - enddo - logical :: ok - call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, Nint) - - do i_state=1,N_states - dIK(i_state) = dij(i_I, idx_alpha(k_sd), i_state) - enddo - - ! - do i_state=1,N_states - dka(i_state) = 0.d0 - enddo - - if (ok) then - do l_sd=k_sd+1,idx_alpha(0) - call get_excitation_degree(tmp_det,psi_non_ref(1,1,idx_alpha(l_sd)),degree,Nint) - if (degree == 0) then - call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(l_sd)),exc,degree,phase2,Nint) - do i_state=1,N_states - dka(i_state) = dij(i_I, idx_alpha(l_sd), i_state) * phase * phase2 - enddo - exit - endif - enddo - - else if (perturbative_triples) then - ! Linked - - hka = hij_cache(idx_alpha(k_sd)) - if (dabs(hka) > 1.d-12) then - call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv) - - do i_state=1,N_states - ASSERT (Delta_E_inv(i_state) < 0.d0) - dka(i_state) = hka / Delta_E_inv(i_state) - enddo - endif - - endif - - if (perturbative_triples.and. (degree2 == 1) ) then - call i_h_j(psi_ref(1,1,i_I),tmp_det,Nint,hka) - hka = hij_cache(idx_alpha(k_sd)) - hka - if (dabs(hka) > 1.d-12) then - call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv) - do i_state=1,N_states - ASSERT (Delta_E_inv(i_state) < 0.d0) - dka(i_state) = hka / Delta_E_inv(i_state) - enddo - endif - - endif - - do i_state=1,N_states - dIa(i_state) = dIa(i_state) + dIk(i_state) * dka(i_state) - enddo - enddo - - do i_state=1,N_states - ci_inv(i_state) = psi_ref_coef_inv(i_I,i_state) - enddo - do l_sd=1,idx_alpha(0) - k_sd = idx_alpha(l_sd) - hla = hij_cache(k_sd) - sla = sij_cache(k_sd) - do i_state=1,N_states - dIa_hla(i_state,k_sd) = dIa(i_state) * hla - dIa_sla(i_state,k_sd) = dIa(i_state) * sla - enddo - enddo - do i_state=1,N_states - do l_sd=1,idx_alpha(0) - k_sd = idx_alpha(l_sd) - hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) - sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) - !$OMP ATOMIC - contrib(i_state) += hdress * psi_ref_coef(dressed_column_idx(i_state), i_state) * psi_non_ref_coef(k_sd, i_state) - !$OMP ATOMIC - delta_ij_(i_state,k_sd) += hdress - !$OMP ATOMIC - delta_ij_s2_(i_state,k_sd) += sdress - enddo - enddo - enddo - enddo - deallocate (dIa_hla,dIa_sla,hij_cache,sij_cache) - deallocate(miniList, idx_miniList) -end - - - BEGIN_PROVIDER [ double precision, mrcc_previous_E, (N_states) ] +BEGIN_PROVIDER [ double precision, mrcc_previous_E, (N_states) ] implicit none BEGIN_DOC !energy difference between last two mrcc iterations END_DOC mrcc_previous_E(:) = ref_bitmask_energy - END_PROVIDER +END_PROVIDER BEGIN_PROVIDER [ double precision, delta_ij_mrcc_zmq, (N_states,N_det_non_ref) ] @@ -881,13 +609,13 @@ END_PROVIDER implicit none integer :: i, j, i_state !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc, 4=stoch - if(mrmode == 4) then - do j = 1, N_det_non_ref - do i_state = 1, N_states - delta_ij(i_state,j) = delta_ij_mrcc_sto(i_state,j) - delta_ij_s2(i_state,j) = delta_ij_s2_mrcc_sto(i_state,j) - enddo - end do +! if(mrmode == 4) then +! do j = 1, N_det_non_ref +! do i_state = 1, N_states +! delta_ij(i_state,j) = delta_ij_mrcc_sto(i_state,j) +! delta_ij_s2(i_state,j) = delta_ij_s2_mrcc_sto(i_state,j) +! enddo +! end do ! else if(mrmode == 10) then ! do j = 1, N_det_non_ref ! do i_state = 1, N_states @@ -895,7 +623,7 @@ END_PROVIDER ! delta_ij_s2(i_state,j) = delta_ij_s2_mrsc2(i_state,j) ! enddo ! end do - else if(mrmode == 5) then + if(mrmode == 5) then do j = 1, N_det_non_ref do i_state = 1, N_states delta_ij(i_state,j) = delta_ij_mrcc_zmq(i_state,j) @@ -1054,60 +782,6 @@ END_PROVIDER END_PROVIDER -! BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] -! use bitmasks -! implicit none -! integer :: i,j,k -! double precision :: Hjk, Hki, Hij, pre(N_det_ref), wall -! integer :: i_state, degree, npre, ipre(N_det_ref), npres(N_det_ref) -! -! ! provide lambda_mrcc -! npres = 0 -! delta_cas = 0d0 -! call wall_time(wall) -! print *, "dcas ", wall -! do i_state = 1, N_states -! !!$OMP PARALLEL DO default(none) schedule(dynamic) private(pre,npre,ipre,j,k,Hjk,Hki,degree) shared(npres,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) -! do k=1,N_det_non_ref -! if(lambda_mrcc(i_state, k) == 0d0) cycle -! npre = 0 -! do i=1,N_det_ref -! call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) -! if(Hki /= 0d0) then -! !!$OMP ATOMIC -! npres(i) += 1 -! npre += 1 -! ipre(npre) = i -! pre(npre) = Hki -! end if -! end do -! -! -! do i=1,npre -! do j=1,i -! !!$OMP ATOMIC -! delta_cas(ipre(i),ipre(j),i_state) += pre(i) * pre(j) * lambda_mrcc(i_state, k) -! end do -! end do -! end do -! !!$OMP END PARALLEL DO -! npre=0 -! do i=1,N_det_ref -! npre += npres(i) -! end do -! !stop -! do i=1,N_det_ref -! do j=1,i -! delta_cas(j,i,i_state) = delta_cas(i,j,i_state) -! end do -! end do -! end do -! -! call wall_time(wall) -! print *, "dcas", wall -! ! stop -! END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] &BEGIN_PROVIDER [ double precision, delta_cas_s2, (N_det_ref, N_det_ref, N_states) ] @@ -1245,11 +919,6 @@ end subroutine idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i enddo - double precision :: c0(N_states) - do i_state=1,N_states - c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) - enddo - ! To provide everything contrib = dij(1, 1, 1) @@ -1261,7 +930,7 @@ end subroutine !$OMP private(m,i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib,contrib_s2) & !$OMP shared(active_sorb, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef, cepa0_shortcut, det_cepa0_active) & !$OMP shared(N_det_ref, N_det_non_ref,N_int,det_cepa0_idx,lambda_mrcc,det_ref_active, delta_cas, delta_cas_s2) & - !$OMP shared(notf,i_state, sortRef, sortRefIdx, dij,c0) + !$OMP shared(notf,i_state, sortRef, sortRefIdx, dij) do blok=1,cepa0_shortcut(0) do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 do II=1,N_det_ref @@ -1305,8 +974,8 @@ end subroutine contrib_s2 = delta_cas_s2(II, J, i_state) * dij(J, det_cepa0_idx(k), i_state) !$OMP ATOMIC - delta_mrcepa0_ij(det_cepa0_idx(i), i_state) += contrib * c0(i_state) * psi_ref_coef(J,i_state) - delta_mrcepa0_ij_s2(det_cepa0_idx(i), i_state) += contrib_s2 * c0(i_state) * psi_ref_coef(J,i_state) + delta_mrcepa0_ij(det_cepa0_idx(i), i_state) += contrib * psi_ref_coef(J,i_state) + delta_mrcepa0_ij_s2(det_cepa0_idx(i), i_state) += contrib_s2 * psi_ref_coef(J,i_state) end do kloop end do @@ -1344,12 +1013,6 @@ BEGIN_PROVIDER [ double precision, delta_sub_ij, (N_det_non_ref,N_states) ] idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i enddo - double precision :: c0(N_states) - do i_state=1,N_states - c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) - enddo - - do i_state = 1, N_states delta_sub_ij(:,:) = 0d0 @@ -1363,7 +1026,7 @@ BEGIN_PROVIDER [ double precision, delta_sub_ij, (N_det_non_ref,N_states) ] !$OMP private(ok, phase_Ji, phase_Ik, phase_Ii, contrib, delta_IJk, HJk, HIk, HIl, exc_Ik, exc_Ji, exc_Ii) & !$OMP private(det_tmp, det_tmp2, II, blok) & !$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & - !$OMP shared(i_state,lambda_mrcc, hf_bitmask, active_sorb,c0) + !$OMP shared(i_state,lambda_mrcc, hf_bitmask, active_sorb) do i=1,N_det_non_ref if(mod(i,1000) == 0) print *, i, "/", N_det_non_ref do J=1,N_det_ref @@ -1411,7 +1074,7 @@ BEGIN_PROVIDER [ double precision, delta_sub_ij, (N_det_non_ref,N_states) ] if(ok) cycle contrib = delta_IJk * HIl * lambda_mrcc(i_state,l) !$OMP ATOMIC - delta_sub_ij(i, i_state) += contrib* c0(i_state) * psi_ref_coef(II,i_state) + delta_sub_ij(i, i_state) += contrib* psi_ref_coef(II,i_state) end do end do end do diff --git a/plugins/mrcepa0/dressing_vector.irp.f b/plugins/mrcepa0/dressing_vector.irp.f index 7c5809d9..d78032f7 100644 --- a/plugins/mrcepa0/dressing_vector.irp.f +++ b/plugins/mrcepa0/dressing_vector.irp.f @@ -16,8 +16,8 @@ f = 1.d0/psi_coef(l,k) do jj = 1, n_det_non_ref j = idx_non_ref(jj) - dressing_column_h(j,k) = delta_ij (k,jj) - dressing_column_s(j,k) = delta_ij_s2(k,jj) + dressing_column_h(j,k) = delta_ij (k,jj) * f + dressing_column_s(j,k) = delta_ij_s2(k,jj) * f enddo tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) dressing_column_h(l,k) -= tmp * f diff --git a/plugins/mrcepa0/run_mrcc_slave.irp.f b/plugins/mrcepa0/run_mrcc_slave.irp.f index c2d871e0..68ee7fc1 100644 --- a/plugins/mrcepa0/run_mrcc_slave.irp.f +++ b/plugins/mrcepa0/run_mrcc_slave.irp.f @@ -97,7 +97,7 @@ subroutine run_mrcc_slave(thread,iproc,energy) n = n - 1 if(n /= 0) then - call mrcc_part_dress_1c(delta_ij_loc(1,1,1), delta_ij_loc(1,1,2), & + call mrcc_part_dress(delta_ij_loc(1,1,1), delta_ij_loc(1,1,2), & i_generator,n,abuf,N_int,omask,contrib) endif end do diff --git a/plugins/DavidsonDressed/NEEDED_CHILDREN_MODULES b/src/DavidsonDressed/NEEDED_CHILDREN_MODULES similarity index 100% rename from plugins/DavidsonDressed/NEEDED_CHILDREN_MODULES rename to src/DavidsonDressed/NEEDED_CHILDREN_MODULES diff --git a/plugins/DavidsonDressed/README.rst b/src/DavidsonDressed/README.rst similarity index 100% rename from plugins/DavidsonDressed/README.rst rename to src/DavidsonDressed/README.rst diff --git a/plugins/DavidsonDressed/diagonalize_CI.irp.f b/src/DavidsonDressed/diagonalize_CI.irp.f similarity index 100% rename from plugins/DavidsonDressed/diagonalize_CI.irp.f rename to src/DavidsonDressed/diagonalize_CI.irp.f diff --git a/src/Davidson_Utils/diagonalization_hs2_dressed.irp.f b/src/Davidson_Utils/diagonalization_hs2_dressed.irp.f index 297db3c5..4e853f32 100644 --- a/src/Davidson_Utils/diagonalization_hs2_dressed.irp.f +++ b/src/Davidson_Utils/diagonalization_hs2_dressed.irp.f @@ -242,8 +242,8 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ if (dressing_state > 0) then + l = dressed_column_idx(dressing_state) do istate=1,N_st_diag - l = dressed_column_idx(dressing_state) do i=1,sze W(i,shift+istate) += dressing_column_h(i,dressing_state) * U(l,shift+istate) S(i,shift+istate) += dressing_column_s(i,dressing_state) * U(l,shift+istate) From 187d7dc66f87d0a117a107bdddfbb946b76772ec Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 19 Feb 2018 15:14:17 +0100 Subject: [PATCH 31/65] Moved DavidsonDressed in plugins --- plugins/All_singles/NEEDED_CHILDREN_MODULES | 2 +- plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES | 2 +- plugins/CID/NEEDED_CHILDREN_MODULES | 2 +- plugins/CID_selected/NEEDED_CHILDREN_MODULES | 2 +- plugins/CIS/NEEDED_CHILDREN_MODULES | 2 +- plugins/CISD/NEEDED_CHILDREN_MODULES | 2 +- plugins/Casino/NEEDED_CHILDREN_MODULES | 2 +- .../DavidsonDressed/NEEDED_CHILDREN_MODULES | 1 + {src => plugins}/DavidsonDressed/README.rst | 0 .../DavidsonDressed/diagonalize_CI.irp.f | 0 plugins/Full_CI/NEEDED_CHILDREN_MODULES | 2 +- plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES | 2 +- plugins/MRPT/NEEDED_CHILDREN_MODULES | 2 +- plugins/Properties/NEEDED_CHILDREN_MODULES | 2 +- plugins/QMC/NEEDED_CHILDREN_MODULES | 2 +- .../UndressedMethod/NEEDED_CHILDREN_MODULES | 1 - src/{Davidson_Utils => Davidson}/EZFIO.cfg | 0 src/Davidson/NEEDED_CHILDREN_MODULES | 2 +- src/Davidson/README.rst | 325 ++++++++++++++++- .../davidson_parallel.irp.f | 0 .../diagonalization.irp.f | 0 .../diagonalization_hs2_dressed.irp.f | 0 .../diagonalize_CI.irp.f | 0 .../find_reference.irp.f | 0 .../parameters.irp.f | 0 src/{Davidson_Utils => Davidson}/u0Hu0.irp.f | 0 src/DavidsonDressed/NEEDED_CHILDREN_MODULES | 1 - src/DavidsonUndressed/NEEDED_CHILDREN_MODULES | 1 + .../DavidsonUndressed}/README.rst | 8 +- .../davidson_slave.irp.f | 0 .../diag_restart_save_all_states.irp.f | 0 .../diag_restart_save_lowest_state.irp.f | 0 .../diag_restart_save_one_state.irp.f | 0 .../guess_lowest_state.irp.f | 0 .../null_dressing_vector.irp.f | 0 .../print_H_matrix_restart.irp.f | 0 .../print_energy.irp.f | 0 src/Davidson_Utils/NEEDED_CHILDREN_MODULES | 1 - src/Davidson_Utils/README.rst | 331 ------------------ 39 files changed, 340 insertions(+), 355 deletions(-) create mode 100644 plugins/DavidsonDressed/NEEDED_CHILDREN_MODULES rename {src => plugins}/DavidsonDressed/README.rst (100%) rename {src => plugins}/DavidsonDressed/diagonalize_CI.irp.f (100%) delete mode 100644 plugins/UndressedMethod/NEEDED_CHILDREN_MODULES rename src/{Davidson_Utils => Davidson}/EZFIO.cfg (100%) rename src/{Davidson_Utils => Davidson}/davidson_parallel.irp.f (100%) rename src/{Davidson_Utils => Davidson}/diagonalization.irp.f (100%) rename src/{Davidson_Utils => Davidson}/diagonalization_hs2_dressed.irp.f (100%) rename src/{Davidson_Utils => Davidson}/diagonalize_CI.irp.f (100%) rename src/{Davidson_Utils => Davidson}/find_reference.irp.f (100%) rename src/{Davidson_Utils => Davidson}/parameters.irp.f (100%) rename src/{Davidson_Utils => Davidson}/u0Hu0.irp.f (100%) delete mode 100644 src/DavidsonDressed/NEEDED_CHILDREN_MODULES create mode 100644 src/DavidsonUndressed/NEEDED_CHILDREN_MODULES rename {plugins/UndressedMethod => src/DavidsonUndressed}/README.rst (70%) rename src/{Davidson => DavidsonUndressed}/davidson_slave.irp.f (100%) rename src/{Davidson => DavidsonUndressed}/diag_restart_save_all_states.irp.f (100%) rename src/{Davidson => DavidsonUndressed}/diag_restart_save_lowest_state.irp.f (100%) rename src/{Davidson => DavidsonUndressed}/diag_restart_save_one_state.irp.f (100%) rename src/{Davidson => DavidsonUndressed}/guess_lowest_state.irp.f (100%) rename src/{Davidson => DavidsonUndressed}/null_dressing_vector.irp.f (100%) rename src/{Davidson => DavidsonUndressed}/print_H_matrix_restart.irp.f (100%) rename src/{Davidson => DavidsonUndressed}/print_energy.irp.f (100%) delete mode 100644 src/Davidson_Utils/NEEDED_CHILDREN_MODULES delete mode 100644 src/Davidson_Utils/README.rst diff --git a/plugins/All_singles/NEEDED_CHILDREN_MODULES b/plugins/All_singles/NEEDED_CHILDREN_MODULES index ee0ff040..6f46f9e1 100644 --- a/plugins/All_singles/NEEDED_CHILDREN_MODULES +++ b/plugins/All_singles/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Generators_restart Perturbation Properties Selectors_no_sorted Utils Davidson +Generators_restart Perturbation Properties Selectors_no_sorted Utils DavidsonUndressed diff --git a/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES b/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES index 6ff49e64..91dd3eff 100644 --- a/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES +++ b/plugins/CAS_SD_ZMQ/NEEDED_CHILDREN_MODULES @@ -1,2 +1,2 @@ -Generators_CAS Perturbation Selectors_CASSD ZMQ Davidson +Generators_CAS Perturbation Selectors_CASSD ZMQ DavidsonUndressed diff --git a/plugins/CID/NEEDED_CHILDREN_MODULES b/plugins/CID/NEEDED_CHILDREN_MODULES index 1632a44d..3272abe5 100644 --- a/plugins/CID/NEEDED_CHILDREN_MODULES +++ b/plugins/CID/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Selectors_full SingleRefMethod Davidson +Selectors_full SingleRefMethod DavidsonUndressed diff --git a/plugins/CID_selected/NEEDED_CHILDREN_MODULES b/plugins/CID_selected/NEEDED_CHILDREN_MODULES index 6b12c0ee..ea9febd6 100644 --- a/plugins/CID_selected/NEEDED_CHILDREN_MODULES +++ b/plugins/CID_selected/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation CID Davidson +Perturbation CID DavidsonUndressed diff --git a/plugins/CIS/NEEDED_CHILDREN_MODULES b/plugins/CIS/NEEDED_CHILDREN_MODULES index 1632a44d..3272abe5 100644 --- a/plugins/CIS/NEEDED_CHILDREN_MODULES +++ b/plugins/CIS/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Selectors_full SingleRefMethod Davidson +Selectors_full SingleRefMethod DavidsonUndressed diff --git a/plugins/CISD/NEEDED_CHILDREN_MODULES b/plugins/CISD/NEEDED_CHILDREN_MODULES index 1632a44d..3272abe5 100644 --- a/plugins/CISD/NEEDED_CHILDREN_MODULES +++ b/plugins/CISD/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Selectors_full SingleRefMethod Davidson +Selectors_full SingleRefMethod DavidsonUndressed diff --git a/plugins/Casino/NEEDED_CHILDREN_MODULES b/plugins/Casino/NEEDED_CHILDREN_MODULES index 34de8ddb..2a87d1c1 100644 --- a/plugins/Casino/NEEDED_CHILDREN_MODULES +++ b/plugins/Casino/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants Davidson +Determinants DavidsonUndressed diff --git a/plugins/DavidsonDressed/NEEDED_CHILDREN_MODULES b/plugins/DavidsonDressed/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..7c334dc7 --- /dev/null +++ b/plugins/DavidsonDressed/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ +Davidson diff --git a/src/DavidsonDressed/README.rst b/plugins/DavidsonDressed/README.rst similarity index 100% rename from src/DavidsonDressed/README.rst rename to plugins/DavidsonDressed/README.rst diff --git a/src/DavidsonDressed/diagonalize_CI.irp.f b/plugins/DavidsonDressed/diagonalize_CI.irp.f similarity index 100% rename from src/DavidsonDressed/diagonalize_CI.irp.f rename to plugins/DavidsonDressed/diagonalize_CI.irp.f diff --git a/plugins/Full_CI/NEEDED_CHILDREN_MODULES b/plugins/Full_CI/NEEDED_CHILDREN_MODULES index ad5f053f..2003b174 100644 --- a/plugins/Full_CI/NEEDED_CHILDREN_MODULES +++ b/plugins/Full_CI/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full Generators_full Davidson +Perturbation Selectors_full Generators_full DavidsonUndressed diff --git a/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES b/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES index 1d6553e8..cc81a88f 100644 --- a/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES +++ b/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full Generators_full ZMQ FourIdx MPI Davidson +Perturbation Selectors_full Generators_full ZMQ FourIdx MPI DavidsonUndressed diff --git a/plugins/MRPT/NEEDED_CHILDREN_MODULES b/plugins/MRPT/NEEDED_CHILDREN_MODULES index 281fbc60..714b3354 100644 --- a/plugins/MRPT/NEEDED_CHILDREN_MODULES +++ b/plugins/MRPT/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -MRPT_Utils Selectors_full Generators_full +MRPT_Utils Selectors_full Generators_full DavidsonUndressed diff --git a/plugins/Properties/NEEDED_CHILDREN_MODULES b/plugins/Properties/NEEDED_CHILDREN_MODULES index 320d5dd0..13e586e2 100644 --- a/plugins/Properties/NEEDED_CHILDREN_MODULES +++ b/plugins/Properties/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants Davidson +Determinants DavidsonUndressed diff --git a/plugins/QMC/NEEDED_CHILDREN_MODULES b/plugins/QMC/NEEDED_CHILDREN_MODULES index 9a2f60c0..b10f6fee 100644 --- a/plugins/QMC/NEEDED_CHILDREN_MODULES +++ b/plugins/QMC/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants Davidson Full_CI_ZMQ +Determinants DavidsonUndressed Full_CI_ZMQ diff --git a/plugins/UndressedMethod/NEEDED_CHILDREN_MODULES b/plugins/UndressedMethod/NEEDED_CHILDREN_MODULES deleted file mode 100644 index 8b137891..00000000 --- a/plugins/UndressedMethod/NEEDED_CHILDREN_MODULES +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/Davidson_Utils/EZFIO.cfg b/src/Davidson/EZFIO.cfg similarity index 100% rename from src/Davidson_Utils/EZFIO.cfg rename to src/Davidson/EZFIO.cfg diff --git a/src/Davidson/NEEDED_CHILDREN_MODULES b/src/Davidson/NEEDED_CHILDREN_MODULES index 22a71c5e..aae89501 100644 --- a/src/Davidson/NEEDED_CHILDREN_MODULES +++ b/src/Davidson/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Davidson_Utils +Determinants diff --git a/src/Davidson/README.rst b/src/Davidson/README.rst index e11d0703..19499c1f 100644 --- a/src/Davidson/README.rst +++ b/src/Davidson/README.rst @@ -1,14 +1,331 @@ -================= -DavidsonUndressed -================= +Davidson_Utils +============== + +Abstract module for Davidson diagonalization. Contains everything required for the +Davidson algorithm, dressed or not. If a dressing is used, the dressing column should +be defined and the DavidsonDressed module should be used. If no dressing is required, +the Davidson module should be used, and it has a default null dressing vector. -Module for main files with undressed Davidson Needed Modules ============== .. Do not edit this section It was auto-generated .. by the `update_README.py` script. + + +.. image:: tree_dependency.png + +* `Determinants `_ + Documentation ============= .. Do not edit this section It was auto-generated .. by the `update_README.py` script. + + +`ci_eigenvectors `_ + Eigenvectors/values of the CI matrix + + +`ci_eigenvectors_s2 `_ + Eigenvectors/values of the CI matrix + + +`ci_electronic_energy `_ + Eigenvectors/values of the CI matrix + + +`ci_energy `_ + N_states lowest eigenvalues of the CI matrix + + +`davidson_collector `_ + Undocumented + + +`davidson_converged `_ + True if the Davidson algorithm is converged + + +`davidson_criterion `_ + Can be : [ energy | residual | both | wall_time | cpu_time | iterations ] + + +`davidson_diag `_ + Davidson diagonalization. + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + iunit : Unit number for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_hjj `_ + Davidson diagonalization with specific diagonal elements of the H matrix + .br + H_jj : specific diagonal H matrix elements to diagonalize de Davidson + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + N_st_diag : Number of states in which H is diagonalized + .br + iunit : Unit for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_hjj_sjj `_ + Davidson diagonalization with specific diagonal elements of the H matrix + .br + H_jj : specific diagonal H matrix elements to diagonalize de Davidson + .br + S2_out : Output : s^2 + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + N_st_diag : Number of states in which H is diagonalized. Assumed > sze + .br + iunit : Unit for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_hs2 `_ + Davidson diagonalization. + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + iunit : Unit number for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_pull_results `_ + Undocumented + + +`davidson_push_results `_ + Undocumented + + +`davidson_run_slave `_ + Undocumented + + +`davidson_slave `_ + Undocumented + + +`davidson_slave_inproc `_ + Undocumented + + +`davidson_slave_tcp `_ + Undocumented + + +`davidson_slave_work `_ + Undocumented + + +`davidson_sze_max `_ + Number of micro-iterations before re-contracting + + +`det_inf `_ + Ordering function for determinants + + +`diag_and_save `_ + Undocumented + + +`diagonalize_ci `_ + Replace the coefficients of the CI states by the coefficients of the + eigenstates of the CI matrix + + +`disk_based_davidson `_ + If true, disk space is used to store the vectors + + +`distributed_davidson `_ + If true, use the distributed algorithm + + +`find_reference `_ + Undocumented + + +`first_guess `_ + Select all the determinants with the lowest energy as a starting point. + + +`h_s2_u_0_nstates `_ + Computes v_0 = H|u_0> and s_0 = S^2 |u_0> + .br + n : number of determinants + .br + H_jj : array of + .br + S2_jj : array of + + +`h_s2_u_0_nstates_openmp `_ + Computes v_0 = H|u_0> and s_0 = S^2 |u_0> + .br + Assumes that the determinants are in psi_det + .br + istart, iend, ishift, istep are used in ZMQ parallelization. + + +`h_s2_u_0_nstates_openmp_work `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_1 `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_2 `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_3 `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_4 `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_openmp_work_n_int `_ + Computes v_t = H|u_t> and s_t = S^2 |u_t> + .br + Default should be 1,N_det,0,1 + + +`h_s2_u_0_nstates_test `_ + Undocumented + + +`h_s2_u_0_nstates_zmq `_ + Computes v_0 = H|u_0> and s_0 = S^2 |u_0> + .br + n : number of determinants + .br + H_jj : array of + .br + S2_jj : array of + + +`h_u_0_nstates `_ + Computes v_0 = H|u_0> + .br + n : number of determinants + .br + H_jj : array of + .br + + +`n_states_diag `_ + Number of states to consider during the Davdison diagonalization + + +`nthreads_davidson `_ + Number of threads for Davdison + + +`print_h_matrix_restart `_ + Undocumented + + +`provide_everything `_ + Undocumented + + +`psi_energy `_ + Energy of the current wave function + + +`routine `_ + Undocumented + + +`sort_dets_ab `_ + Uncodumented : TODO + + +`sort_dets_ab_v `_ + Uncodumented : TODO + + +`sort_dets_ba_v `_ + Uncodumented : TODO + + +`state_following `_ + If true, the states are re-ordered to match the input states + + +`tamiser `_ + Uncodumented : TODO + + +`threshold_davidson `_ + Thresholds of Davidson's algorithm + + +`u_0_h_u_0 `_ + Computes e_0 = / + .br + n : number of determinants + .br + diff --git a/src/Davidson_Utils/davidson_parallel.irp.f b/src/Davidson/davidson_parallel.irp.f similarity index 100% rename from src/Davidson_Utils/davidson_parallel.irp.f rename to src/Davidson/davidson_parallel.irp.f diff --git a/src/Davidson_Utils/diagonalization.irp.f b/src/Davidson/diagonalization.irp.f similarity index 100% rename from src/Davidson_Utils/diagonalization.irp.f rename to src/Davidson/diagonalization.irp.f diff --git a/src/Davidson_Utils/diagonalization_hs2_dressed.irp.f b/src/Davidson/diagonalization_hs2_dressed.irp.f similarity index 100% rename from src/Davidson_Utils/diagonalization_hs2_dressed.irp.f rename to src/Davidson/diagonalization_hs2_dressed.irp.f diff --git a/src/Davidson_Utils/diagonalize_CI.irp.f b/src/Davidson/diagonalize_CI.irp.f similarity index 100% rename from src/Davidson_Utils/diagonalize_CI.irp.f rename to src/Davidson/diagonalize_CI.irp.f diff --git a/src/Davidson_Utils/find_reference.irp.f b/src/Davidson/find_reference.irp.f similarity index 100% rename from src/Davidson_Utils/find_reference.irp.f rename to src/Davidson/find_reference.irp.f diff --git a/src/Davidson_Utils/parameters.irp.f b/src/Davidson/parameters.irp.f similarity index 100% rename from src/Davidson_Utils/parameters.irp.f rename to src/Davidson/parameters.irp.f diff --git a/src/Davidson_Utils/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f similarity index 100% rename from src/Davidson_Utils/u0Hu0.irp.f rename to src/Davidson/u0Hu0.irp.f diff --git a/src/DavidsonDressed/NEEDED_CHILDREN_MODULES b/src/DavidsonDressed/NEEDED_CHILDREN_MODULES deleted file mode 100644 index 22a71c5e..00000000 --- a/src/DavidsonDressed/NEEDED_CHILDREN_MODULES +++ /dev/null @@ -1 +0,0 @@ -Davidson_Utils diff --git a/src/DavidsonUndressed/NEEDED_CHILDREN_MODULES b/src/DavidsonUndressed/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..7c334dc7 --- /dev/null +++ b/src/DavidsonUndressed/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ +Davidson diff --git a/plugins/UndressedMethod/README.rst b/src/DavidsonUndressed/README.rst similarity index 70% rename from plugins/UndressedMethod/README.rst rename to src/DavidsonUndressed/README.rst index 1b739e5c..e11d0703 100644 --- a/plugins/UndressedMethod/README.rst +++ b/src/DavidsonUndressed/README.rst @@ -1,8 +1,8 @@ -=============== -UndressedMethod -=============== +================= +DavidsonUndressed +================= -Defines a null dressing vector +Module for main files with undressed Davidson Needed Modules ============== diff --git a/src/Davidson/davidson_slave.irp.f b/src/DavidsonUndressed/davidson_slave.irp.f similarity index 100% rename from src/Davidson/davidson_slave.irp.f rename to src/DavidsonUndressed/davidson_slave.irp.f diff --git a/src/Davidson/diag_restart_save_all_states.irp.f b/src/DavidsonUndressed/diag_restart_save_all_states.irp.f similarity index 100% rename from src/Davidson/diag_restart_save_all_states.irp.f rename to src/DavidsonUndressed/diag_restart_save_all_states.irp.f diff --git a/src/Davidson/diag_restart_save_lowest_state.irp.f b/src/DavidsonUndressed/diag_restart_save_lowest_state.irp.f similarity index 100% rename from src/Davidson/diag_restart_save_lowest_state.irp.f rename to src/DavidsonUndressed/diag_restart_save_lowest_state.irp.f diff --git a/src/Davidson/diag_restart_save_one_state.irp.f b/src/DavidsonUndressed/diag_restart_save_one_state.irp.f similarity index 100% rename from src/Davidson/diag_restart_save_one_state.irp.f rename to src/DavidsonUndressed/diag_restart_save_one_state.irp.f diff --git a/src/Davidson/guess_lowest_state.irp.f b/src/DavidsonUndressed/guess_lowest_state.irp.f similarity index 100% rename from src/Davidson/guess_lowest_state.irp.f rename to src/DavidsonUndressed/guess_lowest_state.irp.f diff --git a/src/Davidson/null_dressing_vector.irp.f b/src/DavidsonUndressed/null_dressing_vector.irp.f similarity index 100% rename from src/Davidson/null_dressing_vector.irp.f rename to src/DavidsonUndressed/null_dressing_vector.irp.f diff --git a/src/Davidson/print_H_matrix_restart.irp.f b/src/DavidsonUndressed/print_H_matrix_restart.irp.f similarity index 100% rename from src/Davidson/print_H_matrix_restart.irp.f rename to src/DavidsonUndressed/print_H_matrix_restart.irp.f diff --git a/src/Davidson/print_energy.irp.f b/src/DavidsonUndressed/print_energy.irp.f similarity index 100% rename from src/Davidson/print_energy.irp.f rename to src/DavidsonUndressed/print_energy.irp.f diff --git a/src/Davidson_Utils/NEEDED_CHILDREN_MODULES b/src/Davidson_Utils/NEEDED_CHILDREN_MODULES deleted file mode 100644 index aae89501..00000000 --- a/src/Davidson_Utils/NEEDED_CHILDREN_MODULES +++ /dev/null @@ -1 +0,0 @@ -Determinants diff --git a/src/Davidson_Utils/README.rst b/src/Davidson_Utils/README.rst deleted file mode 100644 index 19499c1f..00000000 --- a/src/Davidson_Utils/README.rst +++ /dev/null @@ -1,331 +0,0 @@ -Davidson_Utils -============== - -Abstract module for Davidson diagonalization. Contains everything required for the -Davidson algorithm, dressed or not. If a dressing is used, the dressing column should -be defined and the DavidsonDressed module should be used. If no dressing is required, -the Davidson module should be used, and it has a default null dressing vector. - - -Needed Modules -============== -.. Do not edit this section It was auto-generated -.. by the `update_README.py` script. - - -.. image:: tree_dependency.png - -* `Determinants `_ - -Documentation -============= -.. Do not edit this section It was auto-generated -.. by the `update_README.py` script. - - -`ci_eigenvectors `_ - Eigenvectors/values of the CI matrix - - -`ci_eigenvectors_s2 `_ - Eigenvectors/values of the CI matrix - - -`ci_electronic_energy `_ - Eigenvectors/values of the CI matrix - - -`ci_energy `_ - N_states lowest eigenvalues of the CI matrix - - -`davidson_collector `_ - Undocumented - - -`davidson_converged `_ - True if the Davidson algorithm is converged - - -`davidson_criterion `_ - Can be : [ energy | residual | both | wall_time | cpu_time | iterations ] - - -`davidson_diag `_ - Davidson diagonalization. - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - iunit : Unit number for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_diag_hjj `_ - Davidson diagonalization with specific diagonal elements of the H matrix - .br - H_jj : specific diagonal H matrix elements to diagonalize de Davidson - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - N_st_diag : Number of states in which H is diagonalized - .br - iunit : Unit for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_diag_hjj_sjj `_ - Davidson diagonalization with specific diagonal elements of the H matrix - .br - H_jj : specific diagonal H matrix elements to diagonalize de Davidson - .br - S2_out : Output : s^2 - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - N_st_diag : Number of states in which H is diagonalized. Assumed > sze - .br - iunit : Unit for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_diag_hs2 `_ - Davidson diagonalization. - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - iunit : Unit number for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_pull_results `_ - Undocumented - - -`davidson_push_results `_ - Undocumented - - -`davidson_run_slave `_ - Undocumented - - -`davidson_slave `_ - Undocumented - - -`davidson_slave_inproc `_ - Undocumented - - -`davidson_slave_tcp `_ - Undocumented - - -`davidson_slave_work `_ - Undocumented - - -`davidson_sze_max `_ - Number of micro-iterations before re-contracting - - -`det_inf `_ - Ordering function for determinants - - -`diag_and_save `_ - Undocumented - - -`diagonalize_ci `_ - Replace the coefficients of the CI states by the coefficients of the - eigenstates of the CI matrix - - -`disk_based_davidson `_ - If true, disk space is used to store the vectors - - -`distributed_davidson `_ - If true, use the distributed algorithm - - -`find_reference `_ - Undocumented - - -`first_guess `_ - Select all the determinants with the lowest energy as a starting point. - - -`h_s2_u_0_nstates `_ - Computes v_0 = H|u_0> and s_0 = S^2 |u_0> - .br - n : number of determinants - .br - H_jj : array of - .br - S2_jj : array of - - -`h_s2_u_0_nstates_openmp `_ - Computes v_0 = H|u_0> and s_0 = S^2 |u_0> - .br - Assumes that the determinants are in psi_det - .br - istart, iend, ishift, istep are used in ZMQ parallelization. - - -`h_s2_u_0_nstates_openmp_work `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_1 `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_2 `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_3 `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_4 `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_openmp_work_n_int `_ - Computes v_t = H|u_t> and s_t = S^2 |u_t> - .br - Default should be 1,N_det,0,1 - - -`h_s2_u_0_nstates_test `_ - Undocumented - - -`h_s2_u_0_nstates_zmq `_ - Computes v_0 = H|u_0> and s_0 = S^2 |u_0> - .br - n : number of determinants - .br - H_jj : array of - .br - S2_jj : array of - - -`h_u_0_nstates `_ - Computes v_0 = H|u_0> - .br - n : number of determinants - .br - H_jj : array of - .br - - -`n_states_diag `_ - Number of states to consider during the Davdison diagonalization - - -`nthreads_davidson `_ - Number of threads for Davdison - - -`print_h_matrix_restart `_ - Undocumented - - -`provide_everything `_ - Undocumented - - -`psi_energy `_ - Energy of the current wave function - - -`routine `_ - Undocumented - - -`sort_dets_ab `_ - Uncodumented : TODO - - -`sort_dets_ab_v `_ - Uncodumented : TODO - - -`sort_dets_ba_v `_ - Uncodumented : TODO - - -`state_following `_ - If true, the states are re-ordered to match the input states - - -`tamiser `_ - Uncodumented : TODO - - -`threshold_davidson `_ - Thresholds of Davidson's algorithm - - -`u_0_h_u_0 `_ - Computes e_0 = / - .br - n : number of determinants - .br - From 10ffd8f789bb24b8fbf295bf538a733db8729966 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 19 Feb 2018 17:15:59 +0100 Subject: [PATCH 32/65] non-working mrcc_sto --- plugins/dress_zmq/dressing.irp.f | 2 +- plugins/dress_zmq/dressing_vector.irp.f | 11 +- plugins/dress_zmq/run_dress_slave.irp.f | 12 +- plugins/mrcc_sto/mrcc_sto.irp.f | 199 +++++++++++++++++++++- plugins/mrcepa0/dressing.irp.f | 1 + plugins/mrcepa0/dressing_vector.irp.f | 3 +- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 20 +-- plugins/mrcepa0/run_mrcc_slave.irp.f | 1 - 8 files changed, 222 insertions(+), 27 deletions(-) diff --git a/plugins/dress_zmq/dressing.irp.f b/plugins/dress_zmq/dressing.irp.f index 1aa9c238..1736cc76 100644 --- a/plugins/dress_zmq/dressing.irp.f +++ b/plugins/dress_zmq/dressing.irp.f @@ -86,7 +86,7 @@ END_PROVIDER else errr = 1d-4 end if - relative_error = errr + relative_error = errr * 0d0 print *, "RELATIVE ERROR", relative_error call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error)) diff --git a/plugins/dress_zmq/dressing_vector.irp.f b/plugins/dress_zmq/dressing_vector.irp.f index 6f5f72ad..db1f428b 100644 --- a/plugins/dress_zmq/dressing_vector.irp.f +++ b/plugins/dress_zmq/dressing_vector.irp.f @@ -10,20 +10,23 @@ integer :: i,ii,k,j,jj, l double precision :: f, tmp double precision, external :: u_dot_v - + + print *, "DELTA_IJ", delta_ij(1,:10,1) + print *, "DELTA_IJ div", delta_ij(1,:10,1) / psi_coef(dressed_column_idx(1),1) + !stop do k=1,N_states l = dressed_column_idx(k) f = 1.d0/psi_coef(l,k) do jj = 1, n_det j = jj !idx_non_ref(jj) - dressing_column_h(j,k) = delta_ij (k,jj,1) - dressing_column_s(j,k) = delta_ij (k,jj,2)!delta_ij_s2(k,jj) + dressing_column_h(j,k) = delta_ij (k,jj,1) * f + dressing_column_s(j,k) = delta_ij (k,jj,2) * f!delta_ij_s2(k,jj) enddo tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) dressing_column_h(l,k) -= tmp * f tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) dressing_column_s(l,k) -= tmp * f enddo - + !stop END_PROVIDER diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index 906bfcb3..b40de73d 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -57,12 +57,12 @@ subroutine run_dress_slave(thread,iproc,energy) call alpha_callback(delta_ij_loc, i_generator, subset) !!! SET DRESSING COLUMN? - do i=1,N_det - do i_state=1,N_states - delta_ij_loc(i_state,i,1) = delta_ij_loc(i_state,i,1) / div(i_state) - delta_ij_loc(i_state,i,2) = delta_ij_loc(i_state,i,2) / div(i_state) - end do - end do + !do i=1,N_det + ! do i_state=1,N_states + ! delta_ij_loc(i_state,i,1) = delta_ij_loc(i_state,i,1) / div(i_state) + ! delta_ij_loc(i_state,i,2) = delta_ij_loc(i_state,i,2) / div(i_state) + ! end do + !end do call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) call push_dress_results(zmq_socket_push, i_generator, delta_ij_loc, task_id) diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index a47b0a5b..37b40a0e 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -1,3 +1,4 @@ + program mrcc_sto implicit none BEGIN_DOC @@ -13,13 +14,205 @@ program mrcc_sto call dress_zmq() end + BEGIN_PROVIDER [ integer, idx_non_ref_from_sorted, (N_det) ] +&BEGIN_PROVIDER [ integer, psi_from_sorted, (N_det) ] + implicit none + integer :: i,inpsisor + + idx_non_ref_from_sorted = 0 + psi_from_sorted = 0 + + do i=1,N_det + psi_from_sorted(psi_det_sorted_order(i)) = i + inpsisor = psi_det_sorted_order(i) + if(inpsisor <= 0) stop "idx_non_ref_from_sorted" + idx_non_ref_from_sorted(inpsisor) = idx_non_ref_rev(i) + end do +END_PROVIDER + +subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: alpha(N_int,2) + integer,intent(in) :: minilist(n_minilist), n_minilist + double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) + + + integer :: i,j,k,l,m + integer :: degree1, degree2, degree + integer, allocatable :: idx_alpha(:) + + double precision :: hIk, hla, hIl, sla, dIk(N_states), dka(N_states), dIa(N_states), hka + double precision, allocatable :: dIa_hla(:,:), dIa_sla(:,:) + double precision :: phase, phase2 + double precision :: ci_inv(N_states) + integer :: exc(0:2,2,2) + integer :: h1,h2,p1,p2,s1,s2 + integer(bit_kind) :: tmp_det(N_int,2) + integer :: i_state, k_sd, l_sd, m_sd, ll_sd, i_I + double precision, allocatable :: hij_cache(:), sij_cache(:) + double precision :: Delta_E_inv(N_states) + double precision :: sdress, hdress + double precision :: c0(N_states) + logical :: ok + + + if (perturbative_triples) then + PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat + endif + allocate(hij_cache(N_det), sij_cache(N_det)) + allocate (dIa_hla(N_states,N_det), dIa_sla(N_states,N_det)) + allocate (idx_alpha(0:n_minilist)) + + do i_state=1,N_states + c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) + enddo + ll_sd = 0 + do l_sd=1,n_minilist + ok = .true. + k_sd = minilist(l_sd) + !if(idx_non_ref_rev(k_sd) == 0) cycle + + do i_I=1,N_det_ref + call get_excitation_degree(psi_det_sorted(1,1,k_sd),psi_ref(1,1,i_I),degree1,N_int) + if(degree1 == 0) then + ok = .false. + exit + end if + end do + + if( xor(ok, idx_non_ref_from_sorted(k_sd) > 0)) stop "BUGUE" + if(ok) then + ll_sd += 1 + idx_alpha(ll_sd) = k_sd +! call i_h_j(alpha,psi_non_ref(1,1,idx_alpha(l_sd)),N_int,hij_cache(k_sd)) +! call get_s2(alpha,psi_non_ref(1,1,idx_alpha(l_sd)),N_int,sij_cache(k_sd)) + call i_h_j(alpha,psi_det_sorted(1,1,k_sd),N_int,hij_cache(k_sd)) + call get_s2(alpha,psi_det_sorted(1,1,k_sd),N_int,sij_cache(k_sd)) + end if + enddo + + idx_alpha(0) = ll_sd + + + do i_I=1,N_det_ref + call get_excitation_degree(alpha,psi_ref(1,1,i_I),degree1,N_int) + if (degree1 > 4) then + cycle + endif + + do i_state=1,N_states + dIa(i_state) = 0.d0 + enddo + + do k_sd=1,idx_alpha(0) + !print *, "idx ", k_sd + !print *, "idx2", idx_alpha(k_sd) + !print *, "ref + !if(idx_non_ref_rev(idx_alpha(k_sd)) == 0) cycle + call get_excitation_degree(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha(k_sd)),degree,N_int) +! print *, "diden" + if (degree > 2) then + cycle + endif + + call get_excitation(psi_det_sorted(1,1,idx_alpha(k_sd)),alpha,exc,degree2,phase,N_int) + !print *, "DEG", degree2 + call decode_exc(exc,degree2,h1,p1,h2,p2,s1,s2) + do k=1,N_int + tmp_det(k,1) = psi_ref(k,1,i_I) + tmp_det(k,2) = psi_ref(k,2,i_I) + enddo + call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, N_int) + + do i_state=1,N_states + dIK(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha(k_sd)), i_state) + enddo + + ! + do i_state=1,N_states + dka(i_state) = 0.d0 + enddo + + if (ok) then + do l_sd=k_sd+1,idx_alpha(0) + call get_excitation_degree(tmp_det,psi_det_sorted(1,1,idx_alpha(l_sd)),degree,N_int) + if (degree == 0) then + call get_excitation(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha(l_sd)),exc,degree,phase2,N_int) + do i_state=1,N_states + dka(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha(l_sd)), i_state) * phase * phase2 + enddo + exit + endif + enddo + else if (perturbative_triples) then + hka = hij_cache(idx_alpha(k_sd)) + if (dabs(hka) > 1.d-12) then + call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),alpha,Delta_E_inv) + + do i_state=1,N_states + ASSERT (Delta_E_inv(i_state) < 0.d0) + dka(i_state) = hka / Delta_E_inv(i_state) + enddo + endif + endif + + if (perturbative_triples.and. (degree2 == 1) ) then + call i_h_j(psi_ref(1,1,i_I),tmp_det,N_int,hka) + hka = hij_cache(idx_alpha(k_sd)) - hka + if (dabs(hka) > 1.d-12) then + call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),alpha,Delta_E_inv) + do i_state=1,N_states + ASSERT (Delta_E_inv(i_state) < 0.d0) + dka(i_state) = hka / Delta_E_inv(i_state) + enddo + endif + endif + do i_state=1,N_states + dIa(i_state) = dIa(i_state) + dIk(i_state) * dka(i_state) + enddo + enddo + + do i_state=1,N_states + ci_inv(i_state) = psi_ref_coef_inv(i_I,i_state) + enddo + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + hla = hij_cache(k_sd) + sla = sij_cache(k_sd) + do i_state=1,N_states + dIa_hla(i_state,k_sd) = dIa(i_state) * hla + dIa_sla(i_state,k_sd) = dIa(i_state) * sla + enddo + enddo + do i_state=1,N_states + do l_sd=1,idx_alpha(0) + !print *, "DRES" + !print *, i_state, idx_alpha(l_sd) + k_sd = idx_alpha(l_sd) + m_sd = psi_from_sorted(k_sd) + if(psi_det(1,1,m_sd) /= psi_det_sorted(1,1,k_sd)) stop "psi_from_sorted foireous" + hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) + sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) + !$OMP ATOMIC + delta_ij_loc(i_state,m_sd,1) += hdress + !$OMP ATOMIC + delta_ij_loc(i_state,m_sd,2) += sdress + !print *, "ENDRES" + enddo + enddo + enddo +end subroutine + + + !! TESTS MINILIST -subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) +subroutine test_minilist(minilist, n_minilist, alpha) use bitmasks implicit none - double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) integer, intent(in) :: n_minilist integer(bit_kind),intent(in) :: alpha(N_int, 2) integer, intent(in) :: minilist(n_minilist) @@ -47,8 +240,6 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) exit end if end do - - delta_ij_loc = 0d0 end subroutine diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 93f8edf1..884345ff 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -867,6 +867,7 @@ end else target_error = 1d-4 end if + target_error = 0d0 call ZMQ_mrcc(E_CI_before, mrcc, delta_ij_mrcc_zmq, delta_ij_s2_mrcc_zmq, abs(target_error)) mrcc_previous_E(:) = mrcc_E0_denominator(:) diff --git a/plugins/mrcepa0/dressing_vector.irp.f b/plugins/mrcepa0/dressing_vector.irp.f index 7c5809d9..145bacc8 100644 --- a/plugins/mrcepa0/dressing_vector.irp.f +++ b/plugins/mrcepa0/dressing_vector.irp.f @@ -24,6 +24,7 @@ tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) dressing_column_s(l,k) -= tmp * f enddo - + print *, "DRESS", dressing_column_h(:10,1) +! stop END_PROVIDER diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index cdda311b..d8537a8b 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -114,17 +114,17 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) print *, irp_here, ': Failed in zmq_set_running' endif - !!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) & - ! !$OMP PRIVATE(i) - !i = omp_get_thread_num() - !if (i==0) then - ! call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc) + !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) & + !$OMP PRIVATE(i) + i = omp_get_thread_num() + if (i==0) then + call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc) ! -! else -! call mrcc_slave_inproc(i) -! endif -! !$OMP END PARALLEL - call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc) + else + call mrcc_slave_inproc(i) + endif + !$OMP END PARALLEL +! call mrcc_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, mrcc) call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'mrcc') print *, '========== ================= ================= =================' diff --git a/plugins/mrcepa0/run_mrcc_slave.irp.f b/plugins/mrcepa0/run_mrcc_slave.irp.f index d2e303a3..ee0bc133 100644 --- a/plugins/mrcepa0/run_mrcc_slave.irp.f +++ b/plugins/mrcepa0/run_mrcc_slave.irp.f @@ -69,7 +69,6 @@ subroutine run_mrcc_slave(thread,iproc,energy) else integer :: i_generator, i_i_generator, subset read (task,*) subset, ind - print *, "SLAVE RECEIVED", ind ! if(buf%N == 0) then ! ! Only first time ! call create_selection_buffer(1, 2, buf) From 5150497318b800ca332b9e407790112369362432 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 20 Feb 2018 15:51:53 +0100 Subject: [PATCH 33/65] working but super slow mrcc_sto --- plugins/Full_CI_ZMQ/selection.irp.f | 4 +- plugins/dress_zmq/alpha_factory.irp.f | 44 ++++++++----- plugins/dress_zmq/dressing_vector.irp.f | 13 ++-- plugins/mrcc_sto/mrcc_sto.irp.f | 85 +++++++++++++++++++------ plugins/mrcepa0/dressing.irp.f | 22 ++++++- plugins/mrcepa0/dressing_vector.irp.f | 9 +++ 6 files changed, 136 insertions(+), 41 deletions(-) diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 378e51c4..acda9fa6 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -71,7 +71,6 @@ subroutine select_connected(i_generator,E0,pt2,b,subset) hole_mask(k,2) = iand(generators_bitmask(k,2,s_hole,l), psi_det_generators(k,2,i_generator)) particle_mask(k,1) = iand(generators_bitmask(k,1,s_part,l), not(psi_det_generators(k,1,i_generator)) ) particle_mask(k,2) = iand(generators_bitmask(k,2,s_part,l), not(psi_det_generators(k,2,i_generator)) ) - enddo call select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,b,subset) enddo @@ -299,7 +298,8 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), particle_mask(k,1)) particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), particle_mask(k,2)) enddo - + + integer :: N_holes(2), N_particles(2) integer :: hole_list(N_int*bit_kind_size,2) integer :: particle_list(N_int*bit_kind_size,2) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index a70c22ae..7f2952b7 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -31,6 +31,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii,n integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2), pmask(N_int, 2) + integer(bit_kind) :: mmask(N_int, 2) logical :: fullMatch, ok integer(bit_kind) :: mobMask(N_int, 2), negMask(N_int, 2) @@ -58,11 +59,24 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index monoBdo = .true. do k=1,N_int - hole (k,1) = iand(psi_det_generators(k,1,i_generator), generators_bitmask(k,1,s_hole,bitmask_index)) - hole (k,2) = iand(psi_det_generators(k,2,i_generator), generators_bitmask(k,2,s_hole,bitmask_index)) - particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), generators_bitmask(k,1,s_part,bitmask_index)) - particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), generators_bitmask(k,2,s_part,bitmask_index)) + !hole (k,1) = iand(psi_det_generators(k,1,i_generator), generators_bitmask(k,1,s_hole,bitmask_index)) + !hole (k,2) = iand(psi_det_generators(k,2,i_generator), generators_bitmask(k,2,s_hole,bitmask_index)) + !particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), generators_bitmask(k,1,s_part,bitmask_index)) + !particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), generators_bitmask(k,2,s_part,bitmask_index)) + hole (k,1) = iand(psi_det_generators(k,1,i_generator), full_ijkl_bitmask(k)) + hole (k,2) = iand(psi_det_generators(k,2,i_generator), full_ijkl_bitmask(k)) + particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), full_ijkl_bitmask(k)) + particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), full_ijkl_bitmask(k)) + enddo + + !if(i_generator == 34) then + ! call debug_det(psi_det_generators(1,1,34), N_int) + ! call debug_det(generators_bitmask(1,1,s_part,bitmask_index), N_int) + ! call debug_det(particle, N_int) + ! print *, "dddddddddddd" + ! stop + !end if integer :: N_holes(2), N_particles(2) integer :: hole_list(N_int*bit_kind_size,2) @@ -335,10 +349,10 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index if(siz > size(abuf)) stop "buffer too small in alpha_factory" abuf = 0 call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, indexes_end, abuf, interesting) - indexes_end(:,:) -= 1 - do i=1,siz - if(abuf(i) < 1 .or. abuf(i) > N_det) stop "foireous abuf" - end do + !indexes_end(:,:) -= 1 + !do i=1,siz + ! if(abuf(i) < 1 .or. abuf(i) > N_det) stop "foireous abuf" + !end do !print *, "IND1", indexes(1,:) !print *, "IND2", indexes_end(1,:) !stop @@ -374,7 +388,7 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe allocate(labuf(N_det), putten(N_det)) putten = .false. - st1 = indexes_end(0,0) + st1 = indexes_end(0,0)-1 !! if(st1 > 0) labuf(:st1) = abuf(:st1) st1 += 1 @@ -382,19 +396,19 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe s1 = 1 s2 = 2 lindex(:, 1) = indexes(1:,0) - lindex_end(:,1) = indexes_end(1:,0) + lindex_end(:,1) = indexes_end(1:,0)-1 lindex(:, 2) = indexes(0, 1:) - lindex_end(:, 2) = indexes_end(0, 1:) + lindex_end(:, 2) = indexes_end(0, 1:)-1 else if(sp == 2) then s1 = 2 s2 = 2 lindex(:, 2) = indexes(0, 1:) - lindex_end(:, 2) = indexes_end(0, 1:) + lindex_end(:, 2) = indexes_end(0, 1:)-1 else if(sp == 1) then s1 = 1 s2 = 1 lindex(:, 1) = indexes(1:, 0) - lindex_end(:,1) = indexes_end(1:, 0) + lindex_end(:,1) = indexes_end(1:, 0)-1 end if do i=1,mo_tot_num @@ -432,8 +446,8 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe end if if(indexes(i,j) /= 0) then - st4 = st3 + 1 + indexes_end(i,j)-indexes(i,j) - labuf(st3:st4-1) = abuf(indexes(i,j):indexes_end(i,j)) + st4 = st3 + 1 + indexes_end(i,j)-indexes(i,j) -1!! + labuf(st3:st4-1) = abuf(indexes(i,j):indexes_end(i,j)-1) !! else st4 = st3 end if diff --git a/plugins/dress_zmq/dressing_vector.irp.f b/plugins/dress_zmq/dressing_vector.irp.f index db1f428b..0d24ed94 100644 --- a/plugins/dress_zmq/dressing_vector.irp.f +++ b/plugins/dress_zmq/dressing_vector.irp.f @@ -1,3 +1,9 @@ + BEGIN_PROVIDER [ integer, nalp ] +&BEGIN_PROVIDER [ integer, ninc ] + nalp = 0 + ninc = 0 + END_PROVIDER + BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ] &BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] implicit none @@ -11,9 +17,6 @@ double precision :: f, tmp double precision, external :: u_dot_v - print *, "DELTA_IJ", delta_ij(1,:10,1) - print *, "DELTA_IJ div", delta_ij(1,:10,1) / psi_coef(dressed_column_idx(1),1) - !stop do k=1,N_states l = dressed_column_idx(k) f = 1.d0/psi_coef(l,k) @@ -27,6 +30,8 @@ tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) dressing_column_s(l,k) -= tmp * f enddo - !stop + print *, "NALP", nalp + print *, "NINC", ninc + print *, "DELTA_IJ", dressing_column_h(:10,1) END_PROVIDER diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index 37b40a0e..cde31adb 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -4,18 +4,11 @@ program mrcc_sto BEGIN_DOC ! TODO END_DOC - print *, "========================" - print *, "========================" - print *, "========================" - print *, "MRCC_STO not implemented - acts as a unittest for dress_zmq" - print *, "========================" - print *, "========================" - print *, "========================" call dress_zmq() end - BEGIN_PROVIDER [ integer, idx_non_ref_from_sorted, (N_det) ] -&BEGIN_PROVIDER [ integer, psi_from_sorted, (N_det) ] + BEGIN_PROVIDER [ integer, psi_from_sorted, (N_det) ] +&BEGIN_PROVIDER [ integer, idx_non_ref_from_sorted, (N_det) ] implicit none integer :: i,inpsisor @@ -30,10 +23,17 @@ end end do END_PROVIDER + subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) use bitmasks implicit none - + BEGIN_DOC + !delta_ij_loc(:,:,1) : dressing column for H + !delta_ij_loc(:,:,2) : dressing column for S2 + !minilist : indices of determinants connected to alpha ( in psi_det_sorted ) + !n_minilist : size of minilist + !alpha : alpha determinant + END_DOC integer(bit_kind), intent(in) :: alpha(N_int,2) integer,intent(in) :: minilist(n_minilist), n_minilist double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) @@ -49,22 +49,36 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) double precision :: ci_inv(N_states) integer :: exc(0:2,2,2) integer :: h1,h2,p1,p2,s1,s2 - integer(bit_kind) :: tmp_det(N_int,2) + integer(bit_kind) :: tmp_det(N_int,2), ctrl integer :: i_state, k_sd, l_sd, m_sd, ll_sd, i_I double precision, allocatable :: hij_cache(:), sij_cache(:) double precision :: Delta_E_inv(N_states) double precision :: sdress, hdress double precision :: c0(N_states) - logical :: ok + logical :: ok, ok2 + integer :: old_ninc + double precision :: shdress + if(n_minilist == 1) return + + shdress = 0d0 + old_ninc = ninc + if (perturbative_triples) then PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat endif + + do i_I=1,N_det_ref + call get_excitation_degree(alpha,psi_ref(1,1,i_I),degree1,N_int) + if(degree1 <= 2) return + end do + allocate(hij_cache(N_det), sij_cache(N_det)) allocate (dIa_hla(N_states,N_det), dIa_sla(N_states,N_det)) allocate (idx_alpha(0:n_minilist)) + do i_state=1,N_states c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) enddo @@ -81,18 +95,31 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) exit end if end do + + !if(ok) then + ! call get_excitation(psi_det_sorted(1,1,k_sd),alpha,exc,degree1,phase,N_int) + ! if(degree1 == 0 .or. degree1 > 2) stop "minilist error" + ! call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) + ! + ! if(h1 > 10 .or. p1 < 7 .or. p1 == 8 .or. p1 == 9) ok = .false. + ! if(ok .and. degree1 == 2) then + ! if(h2 > 10 .or. p2 < 7 .or. p2 == 8 .or. p2 == 9) ok = .false. + ! end if + ! !if(degree1 == 0 .or. degree1 > 2) stop "minilist error" + ! !iand(xor(psi_det_sorted(i,2,k_sd), alpha(i,2)), alpha(i,2)) + !end if - if( xor(ok, idx_non_ref_from_sorted(k_sd) > 0)) stop "BUGUE" + !if( xor(ok, idx_non_ref_from_sorted(k_sd) > 0)) stop "BUGUE" if(ok) then ll_sd += 1 idx_alpha(ll_sd) = k_sd ! call i_h_j(alpha,psi_non_ref(1,1,idx_alpha(l_sd)),N_int,hij_cache(k_sd)) ! call get_s2(alpha,psi_non_ref(1,1,idx_alpha(l_sd)),N_int,sij_cache(k_sd)) - call i_h_j(alpha,psi_det_sorted(1,1,k_sd),N_int,hij_cache(k_sd)) - call get_s2(alpha,psi_det_sorted(1,1,k_sd),N_int,sij_cache(k_sd)) + call i_h_j(alpha,psi_det_sorted(1,1,k_sd),N_int,hij_cache(k_sd)) + call get_s2(alpha,psi_det_sorted(1,1,k_sd),N_int,sij_cache(k_sd)) end if enddo - + if(ll_sd <= 1) return idx_alpha(0) = ll_sd @@ -126,9 +153,12 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) enddo call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, N_int) + ok2 = .false. do i_state=1,N_states dIK(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha(k_sd)), i_state) + if(dIK(i_state) /= 0d0) ok2 = .true. enddo + if(.not. ok2) cycle ! do i_state=1,N_states @@ -174,6 +204,12 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) enddo enddo + ok2 = .false. + do i_state=1,N_states + if(dIa(i_state) /= 0d0) ok2 = .true. + enddo + if(.not. ok2) cycle + do i_state=1,N_states ci_inv(i_state) = psi_ref_coef_inv(i_I,i_state) enddo @@ -192,9 +228,15 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) !print *, i_state, idx_alpha(l_sd) k_sd = idx_alpha(l_sd) m_sd = psi_from_sorted(k_sd) - if(psi_det(1,1,m_sd) /= psi_det_sorted(1,1,k_sd)) stop "psi_from_sorted foireous" - hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) - sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) * c0(i_state) + hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state)! * c0(i_state) + sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state)! * c0(i_state) + !!$OMP ATOMIC + !shdress += 1d0 + nalp += 1 + if(hdress /= 0d0) then + ninc = ninc + 1 + !print *, "grepme2", hdress, shdress + end if !$OMP ATOMIC delta_ij_loc(i_state,m_sd,1) += hdress !$OMP ATOMIC @@ -203,6 +245,11 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) enddo enddo enddo + + !if(ninc /= old_ninc) then + ! nalp = nalp + 1 + ! !print "(A8,I20,I20,E15.5)", "grepme", alpha(1,1), alpha(1,2), shdress + !end if end subroutine diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index a7f40b5b..1fc024b5 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -343,7 +343,10 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b !double precision, external :: get_dij, get_dij_index double precision :: Delta_E_inv(N_states) double precision, intent(inout) :: contrib(N_states) - double precision :: sdress, hdress + double precision :: sdress, hdress, shdress + integer :: old_ninc + + old_ninc = ninc if (perturbative_triples) then PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat @@ -408,6 +411,9 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b do i_alpha=1,N_tq + old_ninc = ninc + shdress = 0d0 + if(key_mask(1,1) /= 0) then call getMobiles(tq(1,1,i_alpha), key_mask, mobiles, Nint) @@ -545,6 +551,9 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b k_sd = idx_alpha(l_sd) hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) + !!$OMP ATOMIC + if(hdress /= 0d0) ninc = ninc + 1 + shdress += hdress !$OMP ATOMIC contrib(i_state) += hdress * psi_coef(dressed_column_idx(i_state), i_state) * psi_non_ref_coef(k_sd, i_state) !$OMP ATOMIC @@ -554,7 +563,18 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b enddo enddo enddo + if(ninc /= old_ninc) then + nalp = nalp + 1 + !print "(A8,I20,I20,E15.5)", "grepme", tq(1,1,i_alpha), tq(1,2,i_alpha), shdress + !if(tq(1,1,i_alpha) == 1007 .and. tq(1,2,i_alpha) == 17301943) then + ! print *, "foinder", i_generator + ! call debug_det(psi_det_generators(1,1, i_generator), N_int) + ! call debug_det(tq(1,1,i_alpha), N_int) + ! stop + ! end if + end if enddo + deallocate (dIa_hla,dIa_sla,hij_cache,sij_cache) deallocate(miniList, idx_miniList) end diff --git a/plugins/mrcepa0/dressing_vector.irp.f b/plugins/mrcepa0/dressing_vector.irp.f index 6e6602ea..22394a92 100644 --- a/plugins/mrcepa0/dressing_vector.irp.f +++ b/plugins/mrcepa0/dressing_vector.irp.f @@ -1,3 +1,10 @@ + + BEGIN_PROVIDER [ integer, nalp ] +&BEGIN_PROVIDER [ integer, ninc ] + nalp = 0 + ninc = 0 +END_PROVIDER + BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ] &BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] implicit none @@ -24,6 +31,8 @@ tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) dressing_column_s(l,k) -= tmp * f enddo + print *, "NALP", nalp + print *, "NINC", ninc print *, "DRESS", dressing_column_h(:10,1) ! stop END_PROVIDER From ea99cc29b3b9f82d46c1cf4b809b5fe269b59c63 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Tue, 20 Feb 2018 17:34:51 +0100 Subject: [PATCH 34/65] working and less slow mrcc_sto --- plugins/dress_zmq/alpha_factory.irp.f | 17 +-- plugins/dress_zmq/run_dress_slave.irp.f | 2 +- plugins/mrcc_sto/mrcc_sto.irp.f | 151 +++++++++++------------- 3 files changed, 79 insertions(+), 91 deletions(-) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index 7f2952b7..99ae53fa 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -2,11 +2,12 @@ use bitmasks -subroutine alpha_callback(delta_ij_loc, i_generator, subset) +subroutine alpha_callback(delta_ij_loc, i_generator, subset,iproc) use bitmasks implicit none integer, intent(in) :: i_generator, subset double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) + integer, intent(in) :: iproc integer :: k,l @@ -14,12 +15,12 @@ subroutine alpha_callback(delta_ij_loc, i_generator, subset) do l=1,N_generators_bitmask - call generate_singles_and_doubles(delta_ij_loc, i_generator,l,subset) + call generate_singles_and_doubles(delta_ij_loc, i_generator,l,subset,iproc) enddo end subroutine -subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index, subset) +subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index, subset, iproc) use bitmasks implicit none BEGIN_DOC @@ -28,6 +29,8 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) integer, intent(in) :: i_generator, subset, bitmask_index + integer, intent(in) :: iproc + integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii,n integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2), pmask(N_int, 2) @@ -356,7 +359,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index !print *, "IND1", indexes(1,:) !print *, "IND2", indexes_end(1,:) !stop - call alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz) + call alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz, iproc) !call dress_with_alpha_buffer(delta_ij_loc, minilist, interesting(0), abuf, n) end if @@ -368,12 +371,12 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index end subroutine -subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz) +subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz, iproc) use bitmasks implicit none double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) - integer, intent(in) :: sp, indexes(0:mo_tot_num, 0:mo_tot_num), siz + integer, intent(in) :: sp, indexes(0:mo_tot_num, 0:mo_tot_num), siz, iproc integer, intent(in) :: indexes_end(0:mo_tot_num, 0:mo_tot_num), abuf(*) logical, intent(in) :: bannedOrb(mo_tot_num,2), banned(mo_tot_num, mo_tot_num) integer(bit_kind), intent(in) :: mask(N_int, 2) @@ -456,7 +459,7 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe call apply_particles(mask, s1, i, s2, j, alpha, ok, N_int) !if(.not. ok) stop "non existing alpha......" !print *, "willcall", st4-1, size(labuf) - call dress_with_alpha_buffer(delta_ij_loc, labuf, st4-1, alpha) + call dress_with_alpha_buffer(delta_ij_loc, labuf, st4-1, alpha, iproc) !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) end if end do diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index b40de73d..08d8af3d 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -54,7 +54,7 @@ subroutine run_dress_slave(thread,iproc,energy) if(task_id /= 0) then read (task,*) subset, i_generator delta_ij_loc = 0d0 - call alpha_callback(delta_ij_loc, i_generator, subset) + call alpha_callback(delta_ij_loc, i_generator, subset, iproc) !!! SET DRESSING COLUMN? !do i=1,N_det diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index cde31adb..ea02d85f 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -24,7 +24,17 @@ end END_PROVIDER -subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) + BEGIN_PROVIDER [ double precision, hij_cache_, (N_det,Nproc) ] +&BEGIN_PROVIDER [ double precision, sij_cache_, (N_det,Nproc) ] +&BEGIN_PROVIDER [ double precision, dIa_hla_, (N_states,N_det,Nproc) ] +&BEGIN_PROVIDER [ double precision, dIa_sla_, (N_states,N_det,Nproc) ] +&BEGIN_PROVIDER [ integer, idx_alpha_, (0:N_det,Nproc) ] + BEGIN_DOC + ! temporay arrays for dress_with_alpha_buffer. Avoids realocation. +END_DOC +END_PROVIDER + +subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha, iproc) use bitmasks implicit none BEGIN_DOC @@ -35,31 +45,29 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) !alpha : alpha determinant END_DOC integer(bit_kind), intent(in) :: alpha(N_int,2) - integer,intent(in) :: minilist(n_minilist), n_minilist + integer,intent(in) :: minilist(n_minilist), n_minilist, iproc double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) integer :: i,j,k,l,m integer :: degree1, degree2, degree - integer, allocatable :: idx_alpha(:) double precision :: hIk, hla, hIl, sla, dIk(N_states), dka(N_states), dIa(N_states), hka - double precision, allocatable :: dIa_hla(:,:), dIa_sla(:,:) double precision :: phase, phase2 - double precision :: ci_inv(N_states) integer :: exc(0:2,2,2) integer :: h1,h2,p1,p2,s1,s2 integer(bit_kind) :: tmp_det(N_int,2), ctrl integer :: i_state, k_sd, l_sd, m_sd, ll_sd, i_I - double precision, allocatable :: hij_cache(:), sij_cache(:) double precision :: Delta_E_inv(N_states) double precision :: sdress, hdress - double precision :: c0(N_states) logical :: ok, ok2 integer :: old_ninc double precision :: shdress + PROVIDE mo_class + + if(n_minilist == 1) return shdress = 0d0 @@ -74,53 +82,45 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) if(degree1 <= 2) return end do - allocate(hij_cache(N_det), sij_cache(N_det)) - allocate (dIa_hla(N_states,N_det), dIa_sla(N_states,N_det)) - allocate (idx_alpha(0:n_minilist)) - do i_state=1,N_states - c0(i_state) = 1.d0/psi_coef(dressed_column_idx(i_state),i_state) - enddo ll_sd = 0 do l_sd=1,n_minilist ok = .true. k_sd = minilist(l_sd) !if(idx_non_ref_rev(k_sd) == 0) cycle - do i_I=1,N_det_ref - call get_excitation_degree(psi_det_sorted(1,1,k_sd),psi_ref(1,1,i_I),degree1,N_int) - if(degree1 == 0) then - ok = .false. - exit - end if - end do - - !if(ok) then - ! call get_excitation(psi_det_sorted(1,1,k_sd),alpha,exc,degree1,phase,N_int) - ! if(degree1 == 0 .or. degree1 > 2) stop "minilist error" - ! call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) - ! - ! if(h1 > 10 .or. p1 < 7 .or. p1 == 8 .or. p1 == 9) ok = .false. - ! if(ok .and. degree1 == 2) then - ! if(h2 > 10 .or. p2 < 7 .or. p2 == 8 .or. p2 == 9) ok = .false. + !do i_I=1,N_det_ref + ! call get_excitation_degree(psi_det_sorted(1,1,k_sd),psi_ref(1,1,i_I),degree1,N_int) + ! if(degree1 == 0) then + ! ok = .false. + ! exit ! end if - ! !if(degree1 == 0 .or. degree1 > 2) stop "minilist error" - ! !iand(xor(psi_det_sorted(i,2,k_sd), alpha(i,2)), alpha(i,2)) - !end if + !end do + if(idx_non_ref_from_sorted(k_sd) == 0) ok = .false. + + !if(ok) then + ! call get_excitation(psi_det_sorted(1,1,k_sd),alpha,exc,degree1,phase,N_int) + ! if(degree1 == 0 .or. degree1 > 2) stop "minilist error" + ! call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) + ! + ! ok = (mo_class(h1)(1:1) == 'A' .or. mo_class(h1)(1:1) == 'I') .and. & + ! (mo_class(p1)(1:1) == 'A' .or. mo_class(p1)(1:1) == 'V') + ! if(ok .and. degree1 == 2) then + ! ok = (mo_class(h2)(1:1) == 'A' .or. mo_class(h2)(1:1) == 'I') .and. & + ! (mo_class(p2)(1:1) == 'A' .or. mo_class(p2)(1:1) == 'V') + ! end if + !end if - !if( xor(ok, idx_non_ref_from_sorted(k_sd) > 0)) stop "BUGUE" if(ok) then ll_sd += 1 - idx_alpha(ll_sd) = k_sd -! call i_h_j(alpha,psi_non_ref(1,1,idx_alpha(l_sd)),N_int,hij_cache(k_sd)) -! call get_s2(alpha,psi_non_ref(1,1,idx_alpha(l_sd)),N_int,sij_cache(k_sd)) - call i_h_j(alpha,psi_det_sorted(1,1,k_sd),N_int,hij_cache(k_sd)) - call get_s2(alpha,psi_det_sorted(1,1,k_sd),N_int,sij_cache(k_sd)) + idx_alpha_(ll_sd,iproc) = k_sd + call i_h_j(alpha,psi_det_sorted(1,1,k_sd),N_int,hij_cache_(k_sd,iproc)) + call get_s2(alpha,psi_det_sorted(1,1,k_sd),N_int,sij_cache_(k_sd,iproc)) end if enddo if(ll_sd <= 1) return - idx_alpha(0) = ll_sd + idx_alpha_(0,iproc) = ll_sd do i_I=1,N_det_ref @@ -133,18 +133,14 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) dIa(i_state) = 0.d0 enddo - do k_sd=1,idx_alpha(0) - !print *, "idx ", k_sd - !print *, "idx2", idx_alpha(k_sd) - !print *, "ref - !if(idx_non_ref_rev(idx_alpha(k_sd)) == 0) cycle - call get_excitation_degree(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha(k_sd)),degree,N_int) + do k_sd=1,idx_alpha_(0,iproc) + call get_excitation_degree(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha_(k_sd,iproc)),degree,N_int) ! print *, "diden" if (degree > 2) then cycle endif - call get_excitation(psi_det_sorted(1,1,idx_alpha(k_sd)),alpha,exc,degree2,phase,N_int) + call get_excitation(psi_det_sorted(1,1,idx_alpha_(k_sd,iproc)),alpha,exc,degree2,phase,N_int) !print *, "DEG", degree2 call decode_exc(exc,degree2,h1,p1,h2,p2,s1,s2) do k=1,N_int @@ -155,8 +151,11 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) ok2 = .false. do i_state=1,N_states - dIK(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha(k_sd)), i_state) - if(dIK(i_state) /= 0d0) ok2 = .true. + dIK(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha_(k_sd,iproc)), i_state) + if(dIK(i_state) /= 0d0) then + ok2 = .true. + exit + endif enddo if(.not. ok2) cycle @@ -166,18 +165,18 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) enddo if (ok) then - do l_sd=k_sd+1,idx_alpha(0) - call get_excitation_degree(tmp_det,psi_det_sorted(1,1,idx_alpha(l_sd)),degree,N_int) + do l_sd=k_sd+1,idx_alpha_(0,iproc) + call get_excitation_degree(tmp_det,psi_det_sorted(1,1,idx_alpha_(l_sd,iproc)),degree,N_int) if (degree == 0) then - call get_excitation(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha(l_sd)),exc,degree,phase2,N_int) + call get_excitation(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha_(l_sd,iproc)),exc,degree,phase2,N_int) do i_state=1,N_states - dka(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha(l_sd)), i_state) * phase * phase2 + dka(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha_(l_sd,iproc)), i_state) * phase * phase2 enddo exit endif enddo else if (perturbative_triples) then - hka = hij_cache(idx_alpha(k_sd)) + hka = hij_cache_(idx_alpha_(k_sd,iproc),iproc) if (dabs(hka) > 1.d-12) then call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),alpha,Delta_E_inv) @@ -190,7 +189,7 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) if (perturbative_triples.and. (degree2 == 1) ) then call i_h_j(psi_ref(1,1,i_I),tmp_det,N_int,hka) - hka = hij_cache(idx_alpha(k_sd)) - hka + hka = hij_cache_(idx_alpha_(k_sd,iproc),iproc) - hka if (dabs(hka) > 1.d-12) then call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),alpha,Delta_E_inv) do i_state=1,N_states @@ -210,33 +209,23 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) enddo if(.not. ok2) cycle - do i_state=1,N_states - ci_inv(i_state) = psi_ref_coef_inv(i_I,i_state) - enddo - do l_sd=1,idx_alpha(0) - k_sd = idx_alpha(l_sd) - hla = hij_cache(k_sd) - sla = sij_cache(k_sd) + do l_sd=1,idx_alpha_(0,iproc) + k_sd = idx_alpha_(l_sd,iproc) + hla = hij_cache_(k_sd,iproc) + sla = sij_cache_(k_sd,iproc) do i_state=1,N_states - dIa_hla(i_state,k_sd) = dIa(i_state) * hla - dIa_sla(i_state,k_sd) = dIa(i_state) * sla - enddo - enddo - do i_state=1,N_states - do l_sd=1,idx_alpha(0) - !print *, "DRES" - !print *, i_state, idx_alpha(l_sd) - k_sd = idx_alpha(l_sd) + ! dIa_hla_(i_state,k_sd,iproc) = dIa(i_state) * hla + ! dIa_sla_(i_state,k_sd,iproc) = dIa(i_state) * sla + ! enddo + ! enddo + ! do l_sd=1,idx_alpha_(0,iproc) + ! do i_state=1,N_states + k_sd = idx_alpha_(l_sd,iproc) m_sd = psi_from_sorted(k_sd) - hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state)! * c0(i_state) - sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state)! * c0(i_state) - !!$OMP ATOMIC - !shdress += 1d0 - nalp += 1 - if(hdress /= 0d0) then - ninc = ninc + 1 - !print *, "grepme2", hdress, shdress - end if + hdress = dIa(i_state) * hla * psi_ref_coef(i_I,i_state) + sdress = dIa(i_state) * sla * psi_ref_coef(i_I,i_state) + ! hdress = dIa_hla_(i_state,k_sd,iproc) * psi_ref_coef(i_I,i_state) + ! sdress = dIa_sla_(i_state,k_sd,iproc) * psi_ref_coef(i_I,i_state) !$OMP ATOMIC delta_ij_loc(i_state,m_sd,1) += hdress !$OMP ATOMIC @@ -246,10 +235,6 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha) enddo enddo - !if(ninc /= old_ninc) then - ! nalp = nalp + 1 - ! !print "(A8,I20,I20,E15.5)", "grepme", alpha(1,1), alpha(1,2), shdress - !end if end subroutine From 8524f43715fc46ca0f0fc1d0e0db42673259b792 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 21 Feb 2018 16:45:51 +0100 Subject: [PATCH 35/65] Fixed dependencies in modules --- plugins/MP2/NEEDED_CHILDREN_MODULES | 2 +- plugins/Perturbation/NEEDED_CHILDREN_MODULES | 2 +- plugins/Perturbation/dipole_moment.irp.f | 75 -------------------- 3 files changed, 2 insertions(+), 77 deletions(-) delete mode 100644 plugins/Perturbation/dipole_moment.irp.f diff --git a/plugins/MP2/NEEDED_CHILDREN_MODULES b/plugins/MP2/NEEDED_CHILDREN_MODULES index bdf4b736..cf92308b 100644 --- a/plugins/MP2/NEEDED_CHILDREN_MODULES +++ b/plugins/MP2/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full SingleRefMethod ZMQ +Perturbation Selectors_full SingleRefMethod ZMQ DavidsonUndressed diff --git a/plugins/Perturbation/NEEDED_CHILDREN_MODULES b/plugins/Perturbation/NEEDED_CHILDREN_MODULES index 25b89c5f..c687e4bf 100644 --- a/plugins/Perturbation/NEEDED_CHILDREN_MODULES +++ b/plugins/Perturbation/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants Properties Hartree_Fock Davidson MRPT_Utils +Determinants Hartree_Fock Davidson MRPT_Utils diff --git a/plugins/Perturbation/dipole_moment.irp.f b/plugins/Perturbation/dipole_moment.irp.f deleted file mode 100644 index 0c83436b..00000000 --- a/plugins/Perturbation/dipole_moment.irp.f +++ /dev/null @@ -1,75 +0,0 @@ -subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st,minilist,idx_minilist,N_minilist) - use bitmasks - implicit none - integer, intent(in) :: Nint,ndet,n_st - integer(bit_kind), intent(in) :: det_pert(Nint,2) - double precision , intent(out) :: c_pert(n_st),e_2_pert(n_st),H_pert_diag(N_st) - double precision :: i_O1_psi_array(N_st) - double precision :: i_H_psi_array(N_st) - - integer, intent(in) :: N_minilist - integer, intent(in) :: idx_minilist(0:N_det_selectors) - integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors) - - BEGIN_DOC - ! compute the perturbative contribution to the dipole moment of one determinant - ! - ! for the various n_st states, at various level of theory. - ! - ! c_pert(i) = /( - ) - ! - ! e_2_pert(i) = c_pert(i) * - ! - ! H_pert_diag(i) = c_pert(i)^2 * - ! - ! To get the contribution of the first order : - ! - ! = sum(over i) e_2_pert(i) - ! - ! To get the contribution of the diagonal elements of the second order : - ! - ! [ + + sum(over i) H_pert_diag(i) ] / [1. + sum(over i) c_pert(i) **2] - ! - END_DOC - - integer :: i,j - double precision :: diag_H_mat_elem - integer :: exc(0:2,2,2) - integer :: degree - double precision :: phase,delta_e,h,oii,diag_o1_mat_elem - integer :: h1,h2,p1,p2,s1,s2 - ASSERT (Nint == N_int) - ASSERT (Nint > 0) - -! call get_excitation_degree(HF_bitmask,det_pert,degree,N_int) -! if(degree.gt.degree_max_generators+1)then -! H_pert_diag = 0.d0 -! e_2_pert = 0.d0 -! c_pert = 0.d0 -! return -! endif - - call i_O1_psi(mo_dipole_z,det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_O1_psi_array) - !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) - call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) - - h = diag_H_mat_elem(det_pert,Nint) - oii = diag_O1_mat_elem(mo_dipole_z,det_pert,N_int) - - - do i =1,N_st - if(CI_electronic_energy(i)>h.and.CI_electronic_energy(i).ne.0.d0)then - c_pert(i) = -1.d0 - e_2_pert(i) = selection_criterion*selection_criterion_factor*2.d0 - else if (dabs(CI_electronic_energy(i) - h) > 1.d-6) then - c_pert(i) = i_H_psi_array(i) / (CI_electronic_energy(i) - h) - e_2_pert(i) = c_pert(i) * (i_O1_psi_array(i)+i_O1_psi_array(i) ) - H_pert_diag(i) = e_2_pert(i) + c_pert(i) * c_pert(i) * oii - else - c_pert(i) = -1.d0 - e_2_pert(i) = -dabs(i_H_psi_array(i)) - H_pert_diag(i) = c_pert(i) * i_O1_psi_array(i) - endif - enddo -end - From b177ee3f51bfccc47227a29043abed1c3a99e73f Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 22 Feb 2018 13:41:11 +0100 Subject: [PATCH 36/65] missing files + small optimisation --- plugins/dress_zmq/EZFIO.cfg | 39 +++++++++++++++++++++++ plugins/dress_zmq/NEEDED_CHILDREN_MODULES | 2 ++ plugins/dress_zmq/README.rst | 12 +++++++ plugins/dress_zmq/alpha_factory.irp.f | 2 +- plugins/mrcc_sto/NEEDED_CHILDREN_MODULES | 1 + plugins/mrcc_sto/README.rst | 12 +++++++ plugins/mrcc_sto/mrcc_sto.irp.f | 14 +++----- 7 files changed, 71 insertions(+), 11 deletions(-) create mode 100644 plugins/dress_zmq/EZFIO.cfg create mode 100644 plugins/dress_zmq/NEEDED_CHILDREN_MODULES create mode 100644 plugins/dress_zmq/README.rst create mode 100644 plugins/mrcc_sto/NEEDED_CHILDREN_MODULES create mode 100644 plugins/mrcc_sto/README.rst diff --git a/plugins/dress_zmq/EZFIO.cfg b/plugins/dress_zmq/EZFIO.cfg new file mode 100644 index 00000000..53519ec7 --- /dev/null +++ b/plugins/dress_zmq/EZFIO.cfg @@ -0,0 +1,39 @@ +[lambda_type] +type: Positive_int +doc: lambda type +interface: ezfio,provider,ocaml +default: 0 + +[energy] +type: double precision +doc: Calculated energy +interface: ezfio + +[energy_pt2] +type: double precision +doc: Calculated energy with PT2 contribution +interface: ezfio + +[perturbative_triples] +type: logical +doc: Compute perturbative contribution of the Triples +interface: ezfio,provider,ocaml +default: false + +[energy] +type: double precision +doc: Calculated energy +interface: ezfio + +[thresh_dressed_ci] +type: Threshold +doc: Threshold on the convergence of the dressed CI energy +interface: ezfio,provider,ocaml +default: 1.e-5 + +[n_it_max_dressed_ci] +type: Strictly_positive_int +doc: Maximum number of dressed CI iterations +interface: ezfio,provider,ocaml +default: 10 + diff --git a/plugins/dress_zmq/NEEDED_CHILDREN_MODULES b/plugins/dress_zmq/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..ac2d3444 --- /dev/null +++ b/plugins/dress_zmq/NEEDED_CHILDREN_MODULES @@ -0,0 +1,2 @@ +Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils ZMQ DavidsonDressed + diff --git a/plugins/dress_zmq/README.rst b/plugins/dress_zmq/README.rst new file mode 100644 index 00000000..c272405c --- /dev/null +++ b/plugins/dress_zmq/README.rst @@ -0,0 +1,12 @@ +========= +dress_zmq +========= + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index 99ae53fa..e4fc48ee 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -350,7 +350,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index if(siz > size(abuf)) stop "buffer too small in alpha_factory" - abuf = 0 + !abuf = 0 call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, indexes_end, abuf, interesting) !indexes_end(:,:) -= 1 !do i=1,siz diff --git a/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES b/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..5d17e71f --- /dev/null +++ b/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ +dress_zmq diff --git a/plugins/mrcc_sto/README.rst b/plugins/mrcc_sto/README.rst new file mode 100644 index 00000000..da126dfd --- /dev/null +++ b/plugins/mrcc_sto/README.rst @@ -0,0 +1,12 @@ +======== +mrcc_sto +======== + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index ea02d85f..3c28ee0f 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -69,6 +69,10 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha, ip if(n_minilist == 1) return + + do i=1,n_minilist + if(idx_non_ref_from_sorted(minilist(i)) == 0) return + end do shdress = 0d0 old_ninc = ninc @@ -77,19 +81,10 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha, ip PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat endif - do i_I=1,N_det_ref - call get_excitation_degree(alpha,psi_ref(1,1,i_I),degree1,N_int) - if(degree1 <= 2) return - end do - - - ll_sd = 0 do l_sd=1,n_minilist ok = .true. k_sd = minilist(l_sd) - !if(idx_non_ref_rev(k_sd) == 0) cycle - !do i_I=1,N_det_ref ! call get_excitation_degree(psi_det_sorted(1,1,k_sd),psi_ref(1,1,i_I),degree1,N_int) ! if(degree1 == 0) then @@ -97,7 +92,6 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha, ip ! exit ! end if !end do - if(idx_non_ref_from_sorted(k_sd) == 0) ok = .false. !if(ok) then ! call get_excitation(psi_det_sorted(1,1,k_sd),alpha,exc,degree1,phase,N_int) From 381c9859998f1b3f8f129829f98b0de0850d8a6b Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 22 Feb 2018 14:05:45 +0100 Subject: [PATCH 37/65] mrcc_sto bug for multistate --- plugins/mrcc_sto/mrcc_sto.irp.f | 1 - 1 file changed, 1 deletion(-) diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index 3c28ee0f..4332d571 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -148,7 +148,6 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha, ip dIK(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha_(k_sd,iproc)), i_state) if(dIK(i_state) /= 0d0) then ok2 = .true. - exit endif enddo if(.not. ok2) cycle From bd1aefc567abaabd2bae6ed6f519c23fc7802601 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 22 Feb 2018 15:29:20 +0100 Subject: [PATCH 38/65] det_minilist --- plugins/dress_zmq/alpha_factory.irp.f | 42 +++++++++++++++++---------- plugins/mrcc_sto/mrcc_sto.irp.f | 8 ++--- 2 files changed, 30 insertions(+), 20 deletions(-) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index e4fc48ee..8cb0dcac 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -387,12 +387,19 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe integer :: lindex(mo_tot_num,2), lindex_end(mo_tot_num, 2) integer :: s1, s2, stamo logical,allocatable :: putten(:) + integer(bit_kind), allocatable :: det_minilist(:,:,:) - allocate(labuf(N_det), putten(N_det)) + + allocate(labuf(N_det), putten(N_det), det_minilist(N_int, 2, N_det)) putten = .false. st1 = indexes_end(0,0)-1 !! - if(st1 > 0) labuf(:st1) = abuf(:st1) + if(st1 > 0) then + labuf(:st1) = abuf(:st1) + do i=1,st1 + det_minilist(:,:,i) = psi_det_sorted(:,:,labuf(i)) + end do + end if st1 += 1 if(sp == 3) then @@ -421,6 +428,7 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe labuf(st1:st2-1) = abuf(lindex(i,s1):lindex_end(i,s1)) do j=st1,st2-1 putten(labuf(j)) = .true. + det_minilist(:,:,j) = psi_det_sorted(:,:,labuf(j)) end do else st2 = st1 @@ -439,11 +447,10 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe do k=lindex(j,s2), lindex_end(j,s2) if(.not. putten(abuf(k))) then labuf(st3) = abuf(k) + det_minilist(:,:,st3) = psi_det_sorted(:,:,abuf(k)) st3 += 1 end if end do - !st3 = st2 + 1 + lindex_end(j,s2)-lindex(j,s2) - !labuf(st2:st3-1) = abuf(lindex(j,s2):lindex_end(j,s2)) else st3 = st2 end if @@ -451,6 +458,9 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe if(indexes(i,j) /= 0) then st4 = st3 + 1 + indexes_end(i,j)-indexes(i,j) -1!! labuf(st3:st4-1) = abuf(indexes(i,j):indexes_end(i,j)-1) !! + do k=st3, st4-1 + det_minilist(:,:,k) = psi_det_sorted(:,:,labuf(k)) + end do else st4 = st3 end if @@ -459,7 +469,7 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe call apply_particles(mask, s1, i, s2, j, alpha, ok, N_int) !if(.not. ok) stop "non existing alpha......" !print *, "willcall", st4-1, size(labuf) - call dress_with_alpha_buffer(delta_ij_loc, labuf, st4-1, alpha, iproc) + call dress_with_alpha_buffer(delta_ij_loc, labuf, det_minilist, st4-1, alpha, iproc) !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) end if end do @@ -526,17 +536,17 @@ subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob, negMask(i,2) = not(mask(i,2)) end do - do i=1, N_sel ! interesting(0) - !i = interesting(ii) - if (interesting(i) < 0) then - stop 'prefetch interesting(i)' - endif + do i=1, N_sel + !if (interesting(i) < 0) then + ! stop 'prefetch interesting(i)' + !endif - mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) + if(interesting(i) < i_gen) cycle nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + if(nt > 4) cycle do j=2,N_int @@ -613,7 +623,7 @@ subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob, if(banned(i,j,1)) counted(i,j) = 0 end do end do - + if(sp /= 3) then countedOrb(:, mod(sp, 2)+1) = 0 end if @@ -643,14 +653,14 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, indexes, ab do i=1, N_sel ! interesting(0) !i = interesting(ii) - if (interesting(i) < 0) then - stop 'prefetch interesting(i)' - endif - if(interesting(i) < i_gen) cycle + !if (interesting(i) < 0) then + ! stop 'prefetch interesting(i)' + !endif mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) + if(interesting(i) < i_gen) cycle nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) if(nt > 4) cycle diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index 4332d571..a1fc237a 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -34,7 +34,9 @@ END_PROVIDER END_DOC END_PROVIDER -subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha, iproc) + + +subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minilist, alpha, iproc) use bitmasks implicit none BEGIN_DOC @@ -44,7 +46,7 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha, ip !n_minilist : size of minilist !alpha : alpha determinant END_DOC - integer(bit_kind), intent(in) :: alpha(N_int,2) + integer(bit_kind), intent(in) :: alpha(N_int,2), det_minilist(N_int, 2, n_minilist) integer,intent(in) :: minilist(n_minilist), n_minilist, iproc double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) @@ -63,11 +65,9 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, n_minilist, alpha, ip logical :: ok, ok2 integer :: old_ninc double precision :: shdress - PROVIDE mo_class - if(n_minilist == 1) return do i=1,n_minilist From 4ddeb5c2e57a281be100f1b74d9b4eace9420f97 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 23 Feb 2018 14:02:51 +0100 Subject: [PATCH 39/65] minilist indices in psi_det --- plugins/dress_zmq/alpha_factory.irp.f | 145 +++++++++++++---------- plugins/mrcc_sto/mrcc_sto.irp.f | 161 ++++++++++---------------- 2 files changed, 142 insertions(+), 164 deletions(-) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index 8cb0dcac..f1a3a8e9 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -20,6 +20,23 @@ subroutine alpha_callback(delta_ij_loc, i_generator, subset,iproc) end subroutine + BEGIN_PROVIDER [ integer, psi_from_sorted, (N_det) ] +&BEGIN_PROVIDER [ integer, idx_non_ref_from_sorted, (N_det) ] + implicit none + integer :: i,inpsisor + + idx_non_ref_from_sorted = 0 + psi_from_sorted = 0 + + do i=1,N_det + psi_from_sorted(psi_det_sorted_order(i)) = i + inpsisor = psi_det_sorted_order(i) + if(inpsisor <= 0) stop "idx_non_ref_from_sorted" + idx_non_ref_from_sorted(inpsisor) = idx_non_ref_rev(i) + end do +END_PROVIDER + + subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index, subset, iproc) use bitmasks implicit none @@ -371,17 +388,17 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index end subroutine -subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz, iproc) +subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, rabuf, siz, iproc) use bitmasks implicit none double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) integer, intent(in) :: sp, indexes(0:mo_tot_num, 0:mo_tot_num), siz, iproc - integer, intent(in) :: indexes_end(0:mo_tot_num, 0:mo_tot_num), abuf(*) + integer, intent(in) :: indexes_end(0:mo_tot_num, 0:mo_tot_num), rabuf(*) logical, intent(in) :: bannedOrb(mo_tot_num,2), banned(mo_tot_num, mo_tot_num) integer(bit_kind), intent(in) :: mask(N_int, 2) integer(bit_kind) :: alpha(N_int, 2) - integer, allocatable :: labuf(:) + integer, allocatable :: labuf(:), abuf(:) logical :: ok integer :: i,j,k,s,st1,st2,st3,st4 integer :: lindex(mo_tot_num,2), lindex_end(mo_tot_num, 2) @@ -390,14 +407,19 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe integer(bit_kind), allocatable :: det_minilist(:,:,:) - allocate(labuf(N_det), putten(N_det), det_minilist(N_int, 2, N_det)) + allocate(abuf(siz), labuf(N_det), putten(N_det), det_minilist(N_int, 2, N_det)) + + do i=1,siz + abuf(i) = psi_from_sorted(rabuf(i)) + end do + putten = .false. st1 = indexes_end(0,0)-1 !! if(st1 > 0) then labuf(:st1) = abuf(:st1) do i=1,st1 - det_minilist(:,:,i) = psi_det_sorted(:,:,labuf(i)) + det_minilist(:,:,i) = psi_det(:,:,labuf(i)) end do end if st1 += 1 @@ -421,66 +443,66 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe lindex_end(:,1) = indexes_end(1:, 0)-1 end if - do i=1,mo_tot_num - if(bannedOrb(i,s1)) cycle - if(lindex(i,s1) /= 0) then - st2 = st1 + 1 + lindex_end(i,s1)-lindex(i,s1) - labuf(st1:st2-1) = abuf(lindex(i,s1):lindex_end(i,s1)) - do j=st1,st2-1 - putten(labuf(j)) = .true. - det_minilist(:,:,j) = psi_det_sorted(:,:,labuf(j)) - end do - else - st2 = st1 - end if - - if(sp == 3) then - stamo = 1 - else - stamo = i+1 - end if - - do j=stamo,mo_tot_num - if(bannedOrb(j,s2) .or. banned(i,j)) cycle - if(lindex(j,s2) /= 0) then - st3 = st2 - do k=lindex(j,s2), lindex_end(j,s2) - if(.not. putten(abuf(k))) then - labuf(st3) = abuf(k) - det_minilist(:,:,st3) = psi_det_sorted(:,:,abuf(k)) - st3 += 1 - end if - end do - else - st3 = st2 - end if - - if(indexes(i,j) /= 0) then - st4 = st3 + 1 + indexes_end(i,j)-indexes(i,j) -1!! - labuf(st3:st4-1) = abuf(indexes(i,j):indexes_end(i,j)-1) !! - do k=st3, st4-1 - det_minilist(:,:,k) = psi_det_sorted(:,:,labuf(k)) - end do - else - st4 = st3 - end if - !APPLY PART - if(st4 > 1) then - call apply_particles(mask, s1, i, s2, j, alpha, ok, N_int) - !if(.not. ok) stop "non existing alpha......" - !print *, "willcall", st4-1, size(labuf) - call dress_with_alpha_buffer(delta_ij_loc, labuf, det_minilist, st4-1, alpha, iproc) - !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) - end if + do i=1,mo_tot_num + if(bannedOrb(i,s1)) cycle + if(lindex(i,s1) /= 0) then + st2 = st1 + 1 + lindex_end(i,s1)-lindex(i,s1) + labuf(st1:st2-1) = abuf(lindex(i,s1):lindex_end(i,s1)) + do j=st1,st2-1 + putten(labuf(j)) = .true. + det_minilist(:,:,j) = psi_det(:,:,labuf(j)) end do - - if(lindex(i,s1) /= 0) then - do j=st1,st2-1 - putten(labuf(j)) = .false. + else + st2 = st1 + end if + + if(sp == 3) then + stamo = 1 + else + stamo = i+1 + end if + + do j=stamo,mo_tot_num + if(bannedOrb(j,s2) .or. banned(i,j)) cycle + if(lindex(j,s2) /= 0) then + st3 = st2 + do k=lindex(j,s2), lindex_end(j,s2) + if(.not. putten(abuf(k))) then + labuf(st3) = abuf(k) + det_minilist(:,:,st3) = psi_det(:,:,abuf(k)) + st3 += 1 + end if end do + else + st3 = st2 end if + if(indexes(i,j) /= 0) then + st4 = st3 + 1 + indexes_end(i,j)-indexes(i,j) -1!! + labuf(st3:st4-1) = abuf(indexes(i,j):indexes_end(i,j)-1) !! + do k=st3, st4-1 + det_minilist(:,:,k) = psi_det(:,:,labuf(k)) + end do + else + st4 = st3 + end if + !APPLY PART + if(st4 > 1) then + call apply_particles(mask, s1, i, s2, j, alpha, ok, N_int) + !if(.not. ok) stop "non existing alpha......" + !print *, "willcall", st4-1, size(labuf) + call dress_with_alpha_buffer(delta_ij_loc, labuf, det_minilist, st4-1, alpha, iproc) + !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) + end if end do + + if(lindex(i,s1) /= 0) then + do j=st1,st2-1 + putten(labuf(j)) = .false. + end do + end if + + end do end subroutine @@ -543,7 +565,6 @@ subroutine count_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, countedGlob, mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) - if(interesting(i) < i_gen) cycle nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) @@ -656,11 +677,11 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, indexes, ab !if (interesting(i) < 0) then ! stop 'prefetch interesting(i)' !endif + if(interesting(i) < i_gen) cycle mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) - if(interesting(i) < i_gen) cycle nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) if(nt > 4) cycle diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index a1fc237a..09b5d626 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -7,28 +7,11 @@ program mrcc_sto call dress_zmq() end - BEGIN_PROVIDER [ integer, psi_from_sorted, (N_det) ] -&BEGIN_PROVIDER [ integer, idx_non_ref_from_sorted, (N_det) ] - implicit none - integer :: i,inpsisor - - idx_non_ref_from_sorted = 0 - psi_from_sorted = 0 - - do i=1,N_det - psi_from_sorted(psi_det_sorted_order(i)) = i - inpsisor = psi_det_sorted_order(i) - if(inpsisor <= 0) stop "idx_non_ref_from_sorted" - idx_non_ref_from_sorted(inpsisor) = idx_non_ref_rev(i) - end do -END_PROVIDER - BEGIN_PROVIDER [ double precision, hij_cache_, (N_det,Nproc) ] &BEGIN_PROVIDER [ double precision, sij_cache_, (N_det,Nproc) ] &BEGIN_PROVIDER [ double precision, dIa_hla_, (N_states,N_det,Nproc) ] &BEGIN_PROVIDER [ double precision, dIa_sla_, (N_states,N_det,Nproc) ] -&BEGIN_PROVIDER [ integer, idx_alpha_, (0:N_det,Nproc) ] BEGIN_DOC ! temporay arrays for dress_with_alpha_buffer. Avoids realocation. END_DOC @@ -71,7 +54,7 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil if(n_minilist == 1) return do i=1,n_minilist - if(idx_non_ref_from_sorted(minilist(i)) == 0) return + if(idx_non_ref_rev(minilist(i)) == 0) return end do shdress = 0d0 @@ -81,40 +64,20 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat endif - ll_sd = 0 do l_sd=1,n_minilist - ok = .true. - k_sd = minilist(l_sd) - !do i_I=1,N_det_ref - ! call get_excitation_degree(psi_det_sorted(1,1,k_sd),psi_ref(1,1,i_I),degree1,N_int) - ! if(degree1 == 0) then - ! ok = .false. - ! exit - ! end if - !end do - - !if(ok) then - ! call get_excitation(psi_det_sorted(1,1,k_sd),alpha,exc,degree1,phase,N_int) - ! if(degree1 == 0 .or. degree1 > 2) stop "minilist error" - ! call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) - ! - ! ok = (mo_class(h1)(1:1) == 'A' .or. mo_class(h1)(1:1) == 'I') .and. & - ! (mo_class(p1)(1:1) == 'A' .or. mo_class(p1)(1:1) == 'V') - ! if(ok .and. degree1 == 2) then - ! ok = (mo_class(h2)(1:1) == 'A' .or. mo_class(h2)(1:1) == 'I') .and. & - ! (mo_class(p2)(1:1) == 'A' .or. mo_class(p2)(1:1) == 'V') - ! end if + !call get_excitation(det_minilist(1,1,l_sd),alpha,exc,degree1,phase,N_int) + !if(degree1 == 0 .or. degree1 > 2) stop "minilist error" + !call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) + ! + !ok = (mo_class(h1)(1:1) == 'A' .or. mo_class(h1)(1:1) == 'I') .and. & + ! (mo_class(p1)(1:1) == 'A' .or. mo_class(p1)(1:1) == 'V') + !if(ok .and. degree1 == 2) then + ! ok = (mo_class(h2)(1:1) == 'A' .or. mo_class(h2)(1:1) == 'I') .and. & + ! (mo_class(p2)(1:1) == 'A' .or. mo_class(p2)(1:1) == 'V') !end if - - if(ok) then - ll_sd += 1 - idx_alpha_(ll_sd,iproc) = k_sd - call i_h_j(alpha,psi_det_sorted(1,1,k_sd),N_int,hij_cache_(k_sd,iproc)) - call get_s2(alpha,psi_det_sorted(1,1,k_sd),N_int,sij_cache_(k_sd,iproc)) - end if + call i_h_j(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc)) + call get_s2(alpha,det_minilist(1,1,l_sd),N_int,sij_cache_(l_sd,iproc)) enddo - if(ll_sd <= 1) return - idx_alpha_(0,iproc) = ll_sd do i_I=1,N_det_ref @@ -127,62 +90,68 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil dIa(i_state) = 0.d0 enddo - do k_sd=1,idx_alpha_(0,iproc) - call get_excitation_degree(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha_(k_sd,iproc)),degree,N_int) -! print *, "diden" + do k_sd=1,n_minilist + call get_excitation_degree(psi_ref(1,1,i_I),det_minilist(1,1,k_sd),degree,N_int) if (degree > 2) then cycle endif - call get_excitation(psi_det_sorted(1,1,idx_alpha_(k_sd,iproc)),alpha,exc,degree2,phase,N_int) - !print *, "DEG", degree2 - call decode_exc(exc,degree2,h1,p1,h2,p2,s1,s2) - do k=1,N_int - tmp_det(k,1) = psi_ref(k,1,i_I) - tmp_det(k,2) = psi_ref(k,2,i_I) - enddo + call get_excitation(det_minilist(1,1,k_sd),alpha,exc,degree2,phase,N_int) call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, N_int) - ok2 = .false. - do i_state=1,N_states - dIK(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha_(k_sd,iproc)), i_state) - if(dIK(i_state) /= 0d0) then - ok2 = .true. - endif - enddo - if(.not. ok2) cycle - - ! + if((.not. ok) .and. (.not. perturbative_triples)) cycle + do i_state=1,N_states dka(i_state) = 0.d0 enddo + + ok2 = .false. + !do i_state=1,N_states + ! !if(dka(i_state) == 0) cycle + ! dIk(i_state) = dij(i_I, idx_non_ref_rev(minilist(k_sd)), i_state) + ! if(dIk(i_state) /= 0d0) then + ! ok2 = .true. + ! endif + !enddo + !if(.not. ok2) cycle if (ok) then - do l_sd=k_sd+1,idx_alpha_(0,iproc) - call get_excitation_degree(tmp_det,psi_det_sorted(1,1,idx_alpha_(l_sd,iproc)),degree,N_int) + phase2 = 0d0 + do l_sd=k_sd+1,n_minilist + call get_excitation_degree(tmp_det,det_minilist(1,1,l_sd),degree,N_int) if (degree == 0) then - call get_excitation(psi_ref(1,1,i_I),psi_det_sorted(1,1,idx_alpha_(l_sd,iproc)),exc,degree,phase2,N_int) do i_state=1,N_states - dka(i_state) = dij(i_I, idx_non_ref_from_sorted(idx_alpha_(l_sd,iproc)), i_state) * phase * phase2 - enddo + dIk(i_state) = dij(i_I, idx_non_ref_rev(minilist(k_sd)), i_state) + if(dIk(i_state) /= 0d0) then + if(phase2 == 0d0) call get_excitation(psi_ref(1,1,i_I),det_minilist(1,1,l_sd),exc,degree,phase2,N_int) + dka(i_state) = dij(i_I, idx_non_ref_rev(minilist(l_sd)), i_state) * phase * phase2 + end if + end do + + !call get_excitation(psi_ref(1,1,i_I),det_minilist(1,1,l_sd),exc,degree,phase2,N_int) + !do i_state=1,N_states + ! if(dIk(i_state) /= 0d0) dka(i_state) = dij(i_I, idx_non_ref_rev(minilist(l_sd)), i_state) * phase * phase2 + !enddo exit + endif enddo else if (perturbative_triples) then - hka = hij_cache_(idx_alpha_(k_sd,iproc),iproc) - if (dabs(hka) > 1.d-12) then - call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),alpha,Delta_E_inv) + hka = hij_cache_(k_sd,iproc) + if (dabs(hka) > 1.d-12) then + call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),alpha,Delta_E_inv) - do i_state=1,N_states - ASSERT (Delta_E_inv(i_state) < 0.d0) - dka(i_state) = hka / Delta_E_inv(i_state) - enddo - endif + do i_state=1,N_states + ASSERT (Delta_E_inv(i_state) < 0.d0) + dka(i_state) = hka / Delta_E_inv(i_state) + enddo + endif endif - + + if (perturbative_triples.and. (degree2 == 1) ) then call i_h_j(psi_ref(1,1,i_I),tmp_det,N_int,hka) - hka = hij_cache_(idx_alpha_(k_sd,iproc),iproc) - hka + hka = hij_cache_(k_sd,iproc) - hka if (dabs(hka) > 1.d-12) then call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),alpha,Delta_E_inv) do i_state=1,N_states @@ -202,32 +171,20 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil enddo if(.not. ok2) cycle - do l_sd=1,idx_alpha_(0,iproc) - k_sd = idx_alpha_(l_sd,iproc) - hla = hij_cache_(k_sd,iproc) - sla = sij_cache_(k_sd,iproc) + do l_sd=1,n_minilist + k_sd = minilist(l_sd) + hla = hij_cache_(l_sd,iproc) + sla = sij_cache_(l_sd,iproc) do i_state=1,N_states - ! dIa_hla_(i_state,k_sd,iproc) = dIa(i_state) * hla - ! dIa_sla_(i_state,k_sd,iproc) = dIa(i_state) * sla - ! enddo - ! enddo - ! do l_sd=1,idx_alpha_(0,iproc) - ! do i_state=1,N_states - k_sd = idx_alpha_(l_sd,iproc) - m_sd = psi_from_sorted(k_sd) hdress = dIa(i_state) * hla * psi_ref_coef(i_I,i_state) sdress = dIa(i_state) * sla * psi_ref_coef(i_I,i_state) - ! hdress = dIa_hla_(i_state,k_sd,iproc) * psi_ref_coef(i_I,i_state) - ! sdress = dIa_sla_(i_state,k_sd,iproc) * psi_ref_coef(i_I,i_state) !$OMP ATOMIC - delta_ij_loc(i_state,m_sd,1) += hdress + delta_ij_loc(i_state,k_sd,1) += hdress !$OMP ATOMIC - delta_ij_loc(i_state,m_sd,2) += sdress - !print *, "ENDRES" + delta_ij_loc(i_state,k_sd,2) += sdress enddo enddo enddo - end subroutine From bd767bbb36991be2229f24a94a387e5e64011b0e Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 26 Feb 2018 11:33:32 +0100 Subject: [PATCH 40/65] i_h_j_s2 - optimization in mrcc_sto --- plugins/dress_zmq/dressing_vector.irp.f | 8 -- plugins/mrcc_sto/mrcc_sto.irp.f | 57 +++++++------ plugins/mrcepa0/dressing.irp.f | 19 +---- plugins/mrcepa0/dressing_vector.irp.f | 8 -- src/Determinants/slater_rules.irp.f | 101 ++++++++++++++++++++++++ 5 files changed, 136 insertions(+), 57 deletions(-) diff --git a/plugins/dress_zmq/dressing_vector.irp.f b/plugins/dress_zmq/dressing_vector.irp.f index 0d24ed94..d3e465bd 100644 --- a/plugins/dress_zmq/dressing_vector.irp.f +++ b/plugins/dress_zmq/dressing_vector.irp.f @@ -1,8 +1,3 @@ - BEGIN_PROVIDER [ integer, nalp ] -&BEGIN_PROVIDER [ integer, ninc ] - nalp = 0 - ninc = 0 - END_PROVIDER BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ] &BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] @@ -30,8 +25,5 @@ tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) dressing_column_s(l,k) -= tmp * f enddo - print *, "NALP", nalp - print *, "NINC", ninc - print *, "DELTA_IJ", dressing_column_h(:10,1) END_PROVIDER diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index 09b5d626..0eb6a75e 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -12,7 +12,9 @@ end &BEGIN_PROVIDER [ double precision, sij_cache_, (N_det,Nproc) ] &BEGIN_PROVIDER [ double precision, dIa_hla_, (N_states,N_det,Nproc) ] &BEGIN_PROVIDER [ double precision, dIa_sla_, (N_states,N_det,Nproc) ] - BEGIN_DOC +&BEGIN_PROVIDER [ integer, excs_ , (0:2,2,2,N_det,Nproc) ] +&BEGIN_PROVIDER [ double precision, phases_, (N_det, Nproc) ] +BEGIN_DOC ! temporay arrays for dress_with_alpha_buffer. Avoids realocation. END_DOC END_PROVIDER @@ -46,8 +48,7 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil double precision :: Delta_E_inv(N_states) double precision :: sdress, hdress logical :: ok, ok2 - integer :: old_ninc - double precision :: shdress + integer :: canbediamond PROVIDE mo_class @@ -57,28 +58,33 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil if(idx_non_ref_rev(minilist(i)) == 0) return end do - shdress = 0d0 - old_ninc = ninc - if (perturbative_triples) then PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat endif - + canbediamond = 0 do l_sd=1,n_minilist - !call get_excitation(det_minilist(1,1,l_sd),alpha,exc,degree1,phase,N_int) - !if(degree1 == 0 .or. degree1 > 2) stop "minilist error" - !call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) - ! - !ok = (mo_class(h1)(1:1) == 'A' .or. mo_class(h1)(1:1) == 'I') .and. & - ! (mo_class(p1)(1:1) == 'A' .or. mo_class(p1)(1:1) == 'V') - !if(ok .and. degree1 == 2) then - ! ok = (mo_class(h2)(1:1) == 'A' .or. mo_class(h2)(1:1) == 'I') .and. & - ! (mo_class(p2)(1:1) == 'A' .or. mo_class(p2)(1:1) == 'V') - !end if - call i_h_j(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc)) - call get_s2(alpha,det_minilist(1,1,l_sd),N_int,sij_cache_(l_sd,iproc)) + call get_excitation(det_minilist(1,1,l_sd),alpha,exc,degree1,phase,N_int) + call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) + + ok = (mo_class(h1)(1:1) == 'A' .or. mo_class(h1)(1:1) == 'I') .and. & + (mo_class(p1)(1:1) == 'A' .or. mo_class(p1)(1:1) == 'V') + if(ok .and. degree1 == 2) then + ok = (mo_class(h2)(1:1) == 'A' .or. mo_class(h2)(1:1) == 'I') .and. & + (mo_class(p2)(1:1) == 'A' .or. mo_class(p2)(1:1) == 'V') + end if + + if(ok) then + canbediamond += 1 + excs_(:,:,:,l_sd,iproc) = exc(:,:,:) + phases_(l_sd, iproc) = phase + else + phases_(l_sd, iproc) = 0d0 + end if + !call i_h_j(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc)) + !call get_s2(alpha,det_minilist(1,1,l_sd),N_int,sij_cache_(l_sd,iproc)) + call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc), sij_cache_(l_sd,iproc)) enddo - + if(canbediamond <= 1) return do i_I=1,N_det_ref call get_excitation_degree(alpha,psi_ref(1,1,i_I),degree1,N_int) @@ -91,12 +97,16 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil enddo do k_sd=1,n_minilist + if(phases_(k_sd,iproc) == 0d0) cycle call get_excitation_degree(psi_ref(1,1,i_I),det_minilist(1,1,k_sd),degree,N_int) if (degree > 2) then cycle endif - call get_excitation(det_minilist(1,1,k_sd),alpha,exc,degree2,phase,N_int) + !call get_excitation(det_minilist(1,1,k_sd),alpha,exc,degree2,phase,N_int) + phase = phases_(k_sd, iproc) + exc(:,:,:) = excs_(:,:,:,k_sd,iproc) + degree2 = exc(0,1,1) + exc(0,1,2) call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, N_int) if((.not. ok) .and. (.not. perturbative_triples)) cycle @@ -118,6 +128,7 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil if (ok) then phase2 = 0d0 do l_sd=k_sd+1,n_minilist + if(phases_(l_sd, iproc) == 0d0) cycle call get_excitation_degree(tmp_det,det_minilist(1,1,l_sd),degree,N_int) if (degree == 0) then do i_state=1,N_states @@ -204,11 +215,11 @@ subroutine test_minilist(minilist, n_minilist, alpha) refc = 0 testc = 0 do i=1,N_det - call get_excitation_degree(psi_det_sorted(1,1,i), alpha, deg, N_int) + call get_excitation_degree(psi_det(1,1,i), alpha, deg, N_int) if(deg <= 2) refc(i) = refc(i) + 1 end do do i=1,n_minilist - call get_excitation_degree(psi_det_sorted(1,1,minilist(i)), alpha, deg, N_int) + call get_excitation_degree(psi_det(1,1,minilist(i)), alpha, deg, N_int) if(deg <= 2) then testc(minilist(i)) += 1 else diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 1fc024b5..a376585c 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -343,10 +343,8 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b !double precision, external :: get_dij, get_dij_index double precision :: Delta_E_inv(N_states) double precision, intent(inout) :: contrib(N_states) - double precision :: sdress, hdress, shdress - integer :: old_ninc + double precision :: sdress, hdress - old_ninc = ninc if (perturbative_triples) then PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat @@ -411,9 +409,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b do i_alpha=1,N_tq - old_ninc = ninc - shdress = 0d0 - if(key_mask(1,1) /= 0) then call getMobiles(tq(1,1,i_alpha), key_mask, mobiles, Nint) @@ -552,8 +547,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b hdress = dIa_hla(i_state,k_sd) * psi_ref_coef(i_I,i_state) sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) !!$OMP ATOMIC - if(hdress /= 0d0) ninc = ninc + 1 - shdress += hdress !$OMP ATOMIC contrib(i_state) += hdress * psi_coef(dressed_column_idx(i_state), i_state) * psi_non_ref_coef(k_sd, i_state) !$OMP ATOMIC @@ -563,16 +556,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b enddo enddo enddo - if(ninc /= old_ninc) then - nalp = nalp + 1 - !print "(A8,I20,I20,E15.5)", "grepme", tq(1,1,i_alpha), tq(1,2,i_alpha), shdress - !if(tq(1,1,i_alpha) == 1007 .and. tq(1,2,i_alpha) == 17301943) then - ! print *, "foinder", i_generator - ! call debug_det(psi_det_generators(1,1, i_generator), N_int) - ! call debug_det(tq(1,1,i_alpha), N_int) - ! stop - ! end if - end if enddo deallocate (dIa_hla,dIa_sla,hij_cache,sij_cache) diff --git a/plugins/mrcepa0/dressing_vector.irp.f b/plugins/mrcepa0/dressing_vector.irp.f index 22394a92..933e57b9 100644 --- a/plugins/mrcepa0/dressing_vector.irp.f +++ b/plugins/mrcepa0/dressing_vector.irp.f @@ -1,9 +1,4 @@ - BEGIN_PROVIDER [ integer, nalp ] -&BEGIN_PROVIDER [ integer, ninc ] - nalp = 0 - ninc = 0 -END_PROVIDER BEGIN_PROVIDER [ double precision, dressing_column_h, (N_det,N_states) ] &BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] @@ -31,9 +26,6 @@ END_PROVIDER tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) dressing_column_s(l,k) -= tmp * f enddo - print *, "NALP", nalp - print *, "NINC", ninc - print *, "DRESS", dressing_column_h(:10,1) ! stop END_PROVIDER diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 75baf269..ee597720 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -474,6 +474,107 @@ subroutine bitstring_to_list_ab_old( string, list, n_elements, Nint) end +subroutine i_H_j_s2(key_i,key_j,Nint,hij,s2) + use bitmasks + implicit none + BEGIN_DOC + ! Returns where i and j are determinants + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + double precision, intent(out) :: hij, s2 + + integer :: exc(0:2,2,2) + integer :: degree + double precision :: get_mo_bielec_integral + integer :: m,n,p,q + integer :: i,j,k + integer :: occ(Nint*bit_kind_size,2) + double precision :: diag_H_mat_elem, phase,phase_2 + integer :: n_occ_ab(2) + PROVIDE mo_bielec_integrals_in_map mo_integrals_map big_array_exchange_integrals + + ASSERT (Nint > 0) + ASSERT (Nint == N_int) + ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num) + ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num) + ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num) + + hij = 0.d0 + s2 = 0d0 + !DIR$ FORCEINLINE + call get_excitation_degree(key_i,key_j,degree,Nint) + integer :: spin + select case (degree) + case (2) + call get_double_excitation(key_i,key_j,exc,phase,Nint) + + if (exc(0,1,1) == 1) then + ! Mono alpha, mono beta + if(exc(1,1,1) == exc(1,2,2) )then + if(exc(1,1,2) == exc(1,2,1)) s2 = -phase !!!!! + hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + else if (exc(1,2,1) ==exc(1,1,2))then + hij = phase * big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + else + hij = phase*get_mo_bielec_integral( & + exc(1,1,1), & + exc(1,1,2), & + exc(1,2,1), & + exc(1,2,2) ,mo_integrals_map) + endif + else if (exc(0,1,1) == 2) then + ! Double alpha + hij = phase*(get_mo_bielec_integral( & + exc(1,1,1), & + exc(2,1,1), & + exc(1,2,1), & + exc(2,2,1) ,mo_integrals_map) - & + get_mo_bielec_integral( & + exc(1,1,1), & + exc(2,1,1), & + exc(2,2,1), & + exc(1,2,1) ,mo_integrals_map) ) + else if (exc(0,1,2) == 2) then + ! Double beta + hij = phase*(get_mo_bielec_integral( & + exc(1,1,2), & + exc(2,1,2), & + exc(1,2,2), & + exc(2,2,2) ,mo_integrals_map) - & + get_mo_bielec_integral( & + exc(1,1,2), & + exc(2,1,2), & + exc(2,2,2), & + exc(1,2,2) ,mo_integrals_map) ) + endif + case (1) + call get_mono_excitation(key_i,key_j,exc,phase,Nint) + !DIR$ FORCEINLINE + call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint) + if (exc(0,1,1) == 1) then + ! Mono alpha + m = exc(1,1,1) + p = exc(1,2,1) + spin = 1 + else + ! Mono beta + m = exc(1,1,2) + p = exc(1,2,2) + spin = 2 + endif + call get_mono_excitation_from_fock(key_i,key_j,p,m,spin,phase,hij) + + case (0) + print *," ZERO" + double precision, external :: diag_S_mat_elem + s2 = diag_S_mat_elem(key_i,Nint) + hij = diag_H_mat_elem(key_i,Nint) + end select +end + + subroutine i_H_j(key_i,key_j,Nint,hij) use bitmasks From 2dc927f80a53c47f2d3791d50b0cdbb1f95324d2 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 26 Feb 2018 14:18:49 +0100 Subject: [PATCH 41/65] wrong ezfio variables were set --- plugins/dress_zmq/dress_general.irp.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/dress_zmq/dress_general.irp.f b/plugins/dress_zmq/dress_general.irp.f index 1f33e2d6..6b68de74 100644 --- a/plugins/dress_zmq/dress_general.irp.f +++ b/plugins/dress_zmq/dress_general.irp.f @@ -27,7 +27,7 @@ subroutine run(N_st,energy) enddo SOFT_TOUCH psi_coef ci_energy_dressed call write_double(6,ci_energy_dressed(1),"Final dress energy") - call ezfio_set_mrcepa0_energy(ci_energy_dressed(1)) + call ezfio_set_dress_zmq_energy(ci_energy_dressed(1)) call save_wavefunction else E_new = 0.d0 @@ -53,7 +53,7 @@ subroutine run(N_st,energy) call write_double(6,delta_E,"delta_E") delta_E = dabs(delta_E) call save_wavefunction - call ezfio_set_mrcepa0_energy(ci_energy_dressed(1)) + call ezfio_set_dress_zmq_energy(ci_energy_dressed(1)) if (iteration >= n_it_dress_max) then exit endif @@ -128,7 +128,7 @@ subroutine run_pt2(N_st,energy) print *, 'E+PT2 = ', energy+pt2 print *, '-----' - call ezfio_set_mrcepa0_energy_pt2(energy(1)+pt2(1)) + call ezfio_set_dress_zmq_energy_pt2(energy(1)+pt2(1)) end From ebf96776dd0c1881dd599dface69b70d4fe83a20 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 27 Feb 2018 18:43:07 +0100 Subject: [PATCH 42/65] Fixed Travis --- plugins/Psiref_CAS/overwrite_with_cas.irp.f | 5 --- plugins/dress_zmq/EZFIO.cfg | 39 ------------------- plugins/dress_zmq/EZFIO.cfg.example | 12 ++++++ plugins/dress_zmq/NEEDED_CHILDREN_MODULES | 3 +- plugins/dress_zmq/dress_general.irp.f | 8 ++-- plugins/dress_zmq/dress_slave.irp.f | 2 +- ...ess_zmq.irp.f => dress_zmq_routines.irp.f} | 0 plugins/mrcc_sto/NEEDED_CHILDREN_MODULES | 2 +- plugins/mrcc_sto/mrcc_sto.irp.f | 1 + ...gonalize_restart_and_save_two_states.irp.f | 0 .../save_HF_determinant.irp.f | 0 .../sort_dets_ab.irp.f} | 0 12 files changed, 20 insertions(+), 52 deletions(-) delete mode 100644 plugins/Psiref_CAS/overwrite_with_cas.irp.f delete mode 100644 plugins/dress_zmq/EZFIO.cfg create mode 100644 plugins/dress_zmq/EZFIO.cfg.example rename plugins/dress_zmq/{dress_zmq.irp.f => dress_zmq_routines.irp.f} (100%) rename src/{Determinants => DavidsonUndressed}/diagonalize_restart_and_save_two_states.irp.f (100%) rename src/{Determinants => DavidsonUndressed}/save_HF_determinant.irp.f (100%) rename src/{Davidson/diagonalization.irp.f => Determinants/sort_dets_ab.irp.f} (100%) diff --git a/plugins/Psiref_CAS/overwrite_with_cas.irp.f b/plugins/Psiref_CAS/overwrite_with_cas.irp.f deleted file mode 100644 index d3ced1d1..00000000 --- a/plugins/Psiref_CAS/overwrite_with_cas.irp.f +++ /dev/null @@ -1,5 +0,0 @@ -program overwrite_w_cas - read_wf = .True. - TOUCH read_wf - call extract_ref -end diff --git a/plugins/dress_zmq/EZFIO.cfg b/plugins/dress_zmq/EZFIO.cfg deleted file mode 100644 index 53519ec7..00000000 --- a/plugins/dress_zmq/EZFIO.cfg +++ /dev/null @@ -1,39 +0,0 @@ -[lambda_type] -type: Positive_int -doc: lambda type -interface: ezfio,provider,ocaml -default: 0 - -[energy] -type: double precision -doc: Calculated energy -interface: ezfio - -[energy_pt2] -type: double precision -doc: Calculated energy with PT2 contribution -interface: ezfio - -[perturbative_triples] -type: logical -doc: Compute perturbative contribution of the Triples -interface: ezfio,provider,ocaml -default: false - -[energy] -type: double precision -doc: Calculated energy -interface: ezfio - -[thresh_dressed_ci] -type: Threshold -doc: Threshold on the convergence of the dressed CI energy -interface: ezfio,provider,ocaml -default: 1.e-5 - -[n_it_max_dressed_ci] -type: Strictly_positive_int -doc: Maximum number of dressed CI iterations -interface: ezfio,provider,ocaml -default: 10 - diff --git a/plugins/dress_zmq/EZFIO.cfg.example b/plugins/dress_zmq/EZFIO.cfg.example new file mode 100644 index 00000000..49400b2f --- /dev/null +++ b/plugins/dress_zmq/EZFIO.cfg.example @@ -0,0 +1,12 @@ +[thresh_dressed_ci] +type: Threshold +doc: Threshold on the convergence of the dressed CI energy +interface: ezfio,provider,ocaml +default: 1.e-5 + +[n_it_max_dressed_ci] +type: Strictly_positive_int +doc: Maximum number of dressed CI iterations +interface: ezfio,provider,ocaml +default: 10 + diff --git a/plugins/dress_zmq/NEEDED_CHILDREN_MODULES b/plugins/dress_zmq/NEEDED_CHILDREN_MODULES index ac2d3444..55f8f738 100644 --- a/plugins/dress_zmq/NEEDED_CHILDREN_MODULES +++ b/plugins/dress_zmq/NEEDED_CHILDREN_MODULES @@ -1,2 +1 @@ -Perturbation Selectors_full Generators_full Psiref_CAS MRCC_Utils ZMQ DavidsonDressed - +Selectors_full Generators_full ZMQ diff --git a/plugins/dress_zmq/dress_general.irp.f b/plugins/dress_zmq/dress_general.irp.f index 6b68de74..29dc086d 100644 --- a/plugins/dress_zmq/dress_general.irp.f +++ b/plugins/dress_zmq/dress_general.irp.f @@ -27,7 +27,7 @@ subroutine run(N_st,energy) enddo SOFT_TOUCH psi_coef ci_energy_dressed call write_double(6,ci_energy_dressed(1),"Final dress energy") - call ezfio_set_dress_zmq_energy(ci_energy_dressed(1)) +! call ezfio_set_dress_zmq_energy(ci_energy_dressed(1)) call save_wavefunction else E_new = 0.d0 @@ -53,7 +53,7 @@ subroutine run(N_st,energy) call write_double(6,delta_E,"delta_E") delta_E = dabs(delta_E) call save_wavefunction - call ezfio_set_dress_zmq_energy(ci_energy_dressed(1)) +! call ezfio_set_dress_zmq_energy(ci_energy_dressed(1)) if (iteration >= n_it_dress_max) then exit endif @@ -79,7 +79,7 @@ subroutine print_cas_coefs end -subroutine run_pt2(N_st,energy) +subroutine run_pt2(N_st,energy,pt2) implicit none integer :: i,j,k integer, intent(in) :: N_st @@ -128,7 +128,7 @@ subroutine run_pt2(N_st,energy) print *, 'E+PT2 = ', energy+pt2 print *, '-----' - call ezfio_set_dress_zmq_energy_pt2(energy(1)+pt2(1)) +! call ezfio_set_dress_zmq_energy_pt2(energy(1)+pt2(1)) end diff --git a/plugins/dress_zmq/dress_slave.irp.f b/plugins/dress_zmq/dress_slave.irp.f index 0b742003..c7633b91 100644 --- a/plugins/dress_zmq/dress_slave.irp.f +++ b/plugins/dress_zmq/dress_slave.irp.f @@ -1,7 +1,7 @@ subroutine dress_slave implicit none BEGIN_DOC -! Helper program to compute the dress in distributed mode. +! Helper subroutine to compute the dress in distributed mode. END_DOC read_wf = .False. distributed_davidson = .False. diff --git a/plugins/dress_zmq/dress_zmq.irp.f b/plugins/dress_zmq/dress_zmq_routines.irp.f similarity index 100% rename from plugins/dress_zmq/dress_zmq.irp.f rename to plugins/dress_zmq/dress_zmq_routines.irp.f diff --git a/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES b/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES index 5d17e71f..8416d0f5 100644 --- a/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES +++ b/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -dress_zmq +dress_zmq DavidsonDressed Psiref_CAS MRPT_Utils Perturbation MRCC_Utils diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index 0eb6a75e..b8392f7f 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -5,6 +5,7 @@ program mrcc_sto ! TODO END_DOC call dress_zmq() + call ezfio_set_mrcc_sto_energy(ci_energy_dressed(1)) end diff --git a/src/Determinants/diagonalize_restart_and_save_two_states.irp.f b/src/DavidsonUndressed/diagonalize_restart_and_save_two_states.irp.f similarity index 100% rename from src/Determinants/diagonalize_restart_and_save_two_states.irp.f rename to src/DavidsonUndressed/diagonalize_restart_and_save_two_states.irp.f diff --git a/src/Determinants/save_HF_determinant.irp.f b/src/DavidsonUndressed/save_HF_determinant.irp.f similarity index 100% rename from src/Determinants/save_HF_determinant.irp.f rename to src/DavidsonUndressed/save_HF_determinant.irp.f diff --git a/src/Davidson/diagonalization.irp.f b/src/Determinants/sort_dets_ab.irp.f similarity index 100% rename from src/Davidson/diagonalization.irp.f rename to src/Determinants/sort_dets_ab.irp.f From 005137061e6fc3486d4f3b348b1b30bf6f0bb4e3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 28 Feb 2018 15:28:34 +0100 Subject: [PATCH 43/65] @eginer 's generators_CAS --- plugins/Generators_CAS/generators.irp.f | 32 ++++--------------------- 1 file changed, 5 insertions(+), 27 deletions(-) diff --git a/plugins/Generators_CAS/generators.irp.f b/plugins/Generators_CAS/generators.irp.f index 259af99d..6f96d8e2 100644 --- a/plugins/Generators_CAS/generators.irp.f +++ b/plugins/Generators_CAS/generators.irp.f @@ -7,22 +7,11 @@ BEGIN_PROVIDER [ integer, N_det_generators ] END_DOC integer :: i,k,l logical :: good + integer, external :: number_of_holes,number_of_particles call write_time(6) N_det_generators = 0 do i=1,N_det - do l=1,n_cas_bitmask - good = .True. - do k=1,N_int - good = good .and. ( & - iand(not(cas_bitmask(k,1,l)), psi_det_sorted(k,1,i)) == & - iand(not(cas_bitmask(k,1,l)), HF_bitmask(k,1)) ) .and. ( & - iand(not(cas_bitmask(k,2,l)), psi_det_sorted(k,2,i)) == & - iand(not(cas_bitmask(k,2,l)), HF_bitmask(k,2)) ) - enddo - if (good) then - exit - endif - enddo + good = ( number_of_holes(psi_det_sorted(1,1,i)) ==0).and.(number_of_particles(psi_det_sorted(1,1,i))==0 ) if (good) then N_det_generators += 1 endif @@ -40,28 +29,17 @@ END_PROVIDER END_DOC integer :: i, k, l, m logical :: good + integer :: number_of_holes,number_of_particles m=0 do i=1,N_det - do l=1,n_cas_bitmask - good = .True. - do k=1,N_int - good = good .and. ( & - iand(not(cas_bitmask(k,1,l)), psi_det_sorted(k,1,i)) == & - iand(not(cas_bitmask(k,1,l)), HF_bitmask(k,1)) .and. ( & - iand(not(cas_bitmask(k,2,l)), psi_det_sorted(k,2,i)) == & - iand(not(cas_bitmask(k,2,l)), HF_bitmask(k,2) )) ) - enddo - if (good) then - exit - endif - enddo + good = ( number_of_holes(psi_det_sorted(1,1,i)) ==0).and.(number_of_particles(psi_det_sorted(1,1,i))==0 ) if (good) then m = m+1 do k=1,N_int psi_det_generators(k,1,m) = psi_det_sorted(k,1,i) psi_det_generators(k,2,m) = psi_det_sorted(k,2,i) enddo - psi_coef_generators(m,:) = psi_coef(m,:) + psi_coef_generators(m,:) = psi_coef_sorted(m,:) endif enddo From c9416a5a685249ae2d36e54d5517877a65f994a5 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 28 Feb 2018 16:12:46 +0100 Subject: [PATCH 44/65] Comment to clarify Selectors_CASSD --- plugins/Generators_CAS/generators.irp.f | 2 +- plugins/Selectors_CASSD/selectors.irp.f | 20 ++++++-------------- 2 files changed, 7 insertions(+), 15 deletions(-) diff --git a/plugins/Generators_CAS/generators.irp.f b/plugins/Generators_CAS/generators.irp.f index 6f96d8e2..67d3cc31 100644 --- a/plugins/Generators_CAS/generators.irp.f +++ b/plugins/Generators_CAS/generators.irp.f @@ -29,7 +29,7 @@ END_PROVIDER END_DOC integer :: i, k, l, m logical :: good - integer :: number_of_holes,number_of_particles + integer, external :: number_of_holes,number_of_particles m=0 do i=1,N_det good = ( number_of_holes(psi_det_sorted(1,1,i)) ==0).and.(number_of_particles(psi_det_sorted(1,1,i))==0 ) diff --git a/plugins/Selectors_CASSD/selectors.irp.f b/plugins/Selectors_CASSD/selectors.irp.f index 167ec66e..516f2498 100644 --- a/plugins/Selectors_CASSD/selectors.irp.f +++ b/plugins/Selectors_CASSD/selectors.irp.f @@ -14,9 +14,13 @@ END_PROVIDER implicit none BEGIN_DOC ! Determinants on which we apply for perturbation. + ! The selectors are equivalent to Selectors_full, but in a different + ! order. The Generators_CAS determinants appear first, then all the + ! others. END_DOC integer :: i, k, l, m logical :: good + integer, external :: number_of_holes,number_of_particles do i=1,N_det_generators do k=1,N_int @@ -33,19 +37,7 @@ END_PROVIDER m=N_det_generators do i=1,N_det - do l=1,n_cas_bitmask - good = .True. - do k=1,N_int - good = good .and. ( & - iand(not(cas_bitmask(k,1,l)), psi_det_sorted(k,1,i)) == & - iand(not(cas_bitmask(k,1,l)), HF_bitmask(k,1)) .and. ( & - iand(not(cas_bitmask(k,2,l)), psi_det_sorted(k,2,i)) == & - iand(not(cas_bitmask(k,2,l)), HF_bitmask(k,2) )) ) - enddo - if (good) then - exit - endif - enddo + good = ( number_of_holes(psi_det_sorted(1,1,i)) ==0).and.(number_of_particles(psi_det_sorted(1,1,i))==0 ) if (.not.good) then m = m+1 do k=1,N_int @@ -57,7 +49,7 @@ END_PROVIDER enddo if (N_det /= m) then print *, N_det, m - stop 'N_det /= m' + stop 'Selectors_CASSD : N_det /= m' endif END_PROVIDER From 22b2870b9fa78e632a543a9ac4e0ef44a30ed40d Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 1 Mar 2018 11:35:00 +0100 Subject: [PATCH 45/65] corrected assert(N_states>1) --- plugins/dress_zmq/dress_stoch_routines.irp.f | 30 ++++++++------- plugins/mrcc_sto/mrcc_sto.irp.f | 39 ++++++++++---------- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 9 +++-- 3 files changed, 43 insertions(+), 35 deletions(-) diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 29ca80f7..b5b865ab 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -247,28 +247,28 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, time = omp_get_wtime() - - if(time - timeLast > 1d0 .or. (.not. loop)) then + if((time - timeLast > 2d0) .or. (.not. loop)) then timeLast = time cur_cp = N_cp - if(.not. actually_computed(dress_jobs(1))) cycle pullLoop - - do i=2,N_det_generators + + do i=1,N_det_generators if(.not. actually_computed(dress_jobs(i))) then - cur_cp = done_cp_at(i-1) + if(i /= 1) then + cur_cp = done_cp_at(i-1) + else + cur_cp = 0 + end if exit end if end do if(cur_cp == 0) cycle pullLoop - double precision :: su, su2, eqt, avg, E0, val integer, external :: zmq_abort su = 0d0 su2 = 0d0 - if(N_states > 1) stop "dress_stoch : N_states == 1" do i=1, int(cps_N(cur_cp)) call get_comb_val(comb(i), dress_detail, cur_cp, val) su += val @@ -280,11 +280,14 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, if(cp_first_tooth(cur_cp) <= comb_teeth) then E0 = E0 + dress_detail(1, first_det_of_teeth(cp_first_tooth(cur_cp))) * (1d0-fractage(cp_first_tooth(cur_cp))) end if + + call wall_time(time) if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then ! Termination - !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' -! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed + print "" + print "(A10,I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-time0 + print "" if (zmq_abort(zmq_to_qp_run_socket) == -1) then call sleep(1) if (zmq_abort(zmq_to_qp_run_socket) == -1) then @@ -294,8 +297,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, else if (cur_cp > old_cur_cp) then old_cur_cp = cur_cp -! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed - !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' + print "" + print "(A10,I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-time0 + print "" endif endif end if @@ -355,7 +359,7 @@ end function &BEGIN_PROVIDER [ integer, N_cps_max ] implicit none comb_teeth = 16 - N_cps_max = 32 + N_cps_max = 64 gen_per_cp = (N_det_generators / N_cps_max) + 1 N_cps_max += 1 END_PROVIDER diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index 0eb6a75e..a9942c02 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -61,28 +61,29 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil if (perturbative_triples) then PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat endif + canbediamond = 0 do l_sd=1,n_minilist - call get_excitation(det_minilist(1,1,l_sd),alpha,exc,degree1,phase,N_int) - call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) + call get_excitation(det_minilist(1,1,l_sd),alpha,exc,degree1,phase,N_int) + call decode_exc(exc,degree1,h1,p1,h2,p2,s1,s2) - ok = (mo_class(h1)(1:1) == 'A' .or. mo_class(h1)(1:1) == 'I') .and. & - (mo_class(p1)(1:1) == 'A' .or. mo_class(p1)(1:1) == 'V') - if(ok .and. degree1 == 2) then - ok = (mo_class(h2)(1:1) == 'A' .or. mo_class(h2)(1:1) == 'I') .and. & - (mo_class(p2)(1:1) == 'A' .or. mo_class(p2)(1:1) == 'V') - end if - - if(ok) then - canbediamond += 1 - excs_(:,:,:,l_sd,iproc) = exc(:,:,:) - phases_(l_sd, iproc) = phase - else - phases_(l_sd, iproc) = 0d0 - end if - !call i_h_j(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc)) - !call get_s2(alpha,det_minilist(1,1,l_sd),N_int,sij_cache_(l_sd,iproc)) - call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc), sij_cache_(l_sd,iproc)) + ok = (mo_class(h1)(1:1) == 'A' .or. mo_class(h1)(1:1) == 'I') .and. & + (mo_class(p1)(1:1) == 'A' .or. mo_class(p1)(1:1) == 'V') + if(ok .and. degree1 == 2) then + ok = (mo_class(h2)(1:1) == 'A' .or. mo_class(h2)(1:1) == 'I') .and. & + (mo_class(p2)(1:1) == 'A' .or. mo_class(p2)(1:1) == 'V') + end if + + if(ok) then + canbediamond += 1 + excs_(:,:,:,l_sd,iproc) = exc(:,:,:) + phases_(l_sd, iproc) = phase + else + phases_(l_sd, iproc) = 0d0 + end if + !call i_h_j(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc)) + !call get_s2(alpha,det_minilist(1,1,l_sd),N_int,sij_cache_(l_sd,iproc)) + call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij_cache_(l_sd,iproc), sij_cache_(l_sd,iproc)) enddo if(canbediamond <= 1) return diff --git a/plugins/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index d8537a8b..45907679 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -365,9 +365,12 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m if(cp_first_tooth(cur_cp) <= comb_teeth) then E0 = E0 + mrcc_detail(1, first_det_of_teeth(cp_first_tooth(cur_cp))) * (1d0-fractage(cp_first_tooth(cur_cp))) end if - - print "(I5,F15.7,E12.4,F10.2)", cur_cp, E+E0+avg, eqt, time-timeInit - + + if(cur_cp /= old_cur_cp) then + old_cur_cp = cur_cp + print "(A10, I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-timeInit + end if + if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then if (zmq_abort(zmq_to_qp_run_socket) == -1) then call sleep(1) From 1a0f36dfa51f3a7748b80ce9231929b967af2439 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 2 Mar 2018 15:29:58 +0100 Subject: [PATCH 46/65] init shiftedbk --- plugins/Full_CI_ZMQ/selection.irp.f | 8 ++- plugins/dress_zmq/alpha_factory.irp.f | 8 +-- plugins/dress_zmq/dress_stoch_routines.irp.f | 8 +-- plugins/mrcc_sto/mrcc_sto.irp.f | 8 +-- plugins/shiftedbk/NEEDED_CHILDREN_MODULES | 1 + plugins/shiftedbk/README.rst | 12 ++++ plugins/shiftedbk/shifted_bk.irp.f | 60 ++++++++++++++++++++ 7 files changed, 92 insertions(+), 13 deletions(-) create mode 100644 plugins/shiftedbk/NEEDED_CHILDREN_MODULES create mode 100644 plugins/shiftedbk/README.rst create mode 100644 plugins/shiftedbk/shifted_bk.irp.f diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index acda9fa6..b3256f6a 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -774,6 +774,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) if(tip == 3) then puti = p(1, mi) + if(bannedOrb(puti, mi)) return do i = 1, 3 putj = p(i, ma) if(banned(putj,puti,bant)) cycle @@ -796,11 +797,12 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) h2 = h(1,2) do j = 1,2 putj = p(j, 2) + if(bannedOrb(putj, 2)) cycle p2 = p(turn2(j), 2) do i = 1,2 puti = p(i, 1) - if(banned(puti,putj,bant)) cycle + if(banned(puti,putj,bant) .or. bannedOrb(puti,1)) cycle p1 = p(turn2(i), 1) hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) @@ -815,8 +817,10 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) h2 = h(2, ma) do i=1,3 puti = p(i, ma) + if(bannedOrb(puti,ma)) cycle do j=i+1,4 putj = p(j, ma) + if(bannedOrb(putj,ma)) cycle if(banned(puti,putj,1)) cycle i1 = turn2d(1, i, j) @@ -833,7 +837,9 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) p1 = p(1, mi) do i=1,3 puti = p(turn3(1,i), ma) + if(bannedOrb(puti,ma)) cycle putj = p(turn3(2,i), ma) + if(bannedOrb(putj,ma)) cycle if(banned(puti,putj,1)) cycle p2 = p(i, ma) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index f1a3a8e9..93196cc8 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -376,7 +376,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index !print *, "IND1", indexes(1,:) !print *, "IND2", indexes_end(1,:) !stop - call alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz, iproc) + call alpha_callback_mask(delta_ij_loc, i_generator, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz, iproc) !call dress_with_alpha_buffer(delta_ij_loc, minilist, interesting(0), abuf, n) end if @@ -388,12 +388,12 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index end subroutine -subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, rabuf, siz, iproc) +subroutine alpha_callback_mask(delta_ij_loc, i_gen, sp, mask, bannedOrb, banned, indexes, indexes_end, rabuf, siz, iproc) use bitmasks implicit none double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) - integer, intent(in) :: sp, indexes(0:mo_tot_num, 0:mo_tot_num), siz, iproc + integer, intent(in) :: sp, indexes(0:mo_tot_num, 0:mo_tot_num), siz, iproc, i_gen integer, intent(in) :: indexes_end(0:mo_tot_num, 0:mo_tot_num), rabuf(*) logical, intent(in) :: bannedOrb(mo_tot_num,2), banned(mo_tot_num, mo_tot_num) integer(bit_kind), intent(in) :: mask(N_int, 2) @@ -491,7 +491,7 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe call apply_particles(mask, s1, i, s2, j, alpha, ok, N_int) !if(.not. ok) stop "non existing alpha......" !print *, "willcall", st4-1, size(labuf) - call dress_with_alpha_buffer(delta_ij_loc, labuf, det_minilist, st4-1, alpha, iproc) + call dress_with_alpha_buffer(delta_ij_loc, i_gen, labuf, det_minilist, st4-1, alpha, iproc) !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) end if end do diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index b5b865ab..65f9799e 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -285,9 +285,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, call wall_time(time) if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then ! Termination - print "" + print *,"" print "(A10,I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-time0 - print "" + print *,"" if (zmq_abort(zmq_to_qp_run_socket) == -1) then call sleep(1) if (zmq_abort(zmq_to_qp_run_socket) == -1) then @@ -297,9 +297,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, else if (cur_cp > old_cur_cp) then old_cur_cp = cur_cp - print "" + print *,"" print "(A10,I5,F15.7,E12.4,F10.2)", "grepme", cur_cp, E+E0+avg, eqt, time-time0 - print "" + print *,"" endif endif end if diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index a9942c02..f94d9409 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -21,7 +21,7 @@ END_PROVIDER -subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minilist, alpha, iproc) +subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) use bitmasks implicit none BEGIN_DOC @@ -32,7 +32,7 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil !alpha : alpha determinant END_DOC integer(bit_kind), intent(in) :: alpha(N_int,2), det_minilist(N_int, 2, n_minilist) - integer,intent(in) :: minilist(n_minilist), n_minilist, iproc + integer,intent(in) :: minilist(n_minilist), n_minilist, iproc, i_gen double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) @@ -190,9 +190,9 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, minilist, det_minilist, n_minil do i_state=1,N_states hdress = dIa(i_state) * hla * psi_ref_coef(i_I,i_state) sdress = dIa(i_state) * sla * psi_ref_coef(i_I,i_state) - !$OMP ATOMIC + !!!$OMP ATOMIC delta_ij_loc(i_state,k_sd,1) += hdress - !$OMP ATOMIC + !!!$OMP ATOMIC delta_ij_loc(i_state,k_sd,2) += sdress enddo enddo diff --git a/plugins/shiftedbk/NEEDED_CHILDREN_MODULES b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..5d17e71f --- /dev/null +++ b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ +dress_zmq diff --git a/plugins/shiftedbk/README.rst b/plugins/shiftedbk/README.rst new file mode 100644 index 00000000..d2fa5135 --- /dev/null +++ b/plugins/shiftedbk/README.rst @@ -0,0 +1,12 @@ +========= +shiftedbk +========= + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. diff --git a/plugins/shiftedbk/shifted_bk.irp.f b/plugins/shiftedbk/shifted_bk.irp.f new file mode 100644 index 00000000..12c867d6 --- /dev/null +++ b/plugins/shiftedbk/shifted_bk.irp.f @@ -0,0 +1,60 @@ + +program mrcc_sto + implicit none + BEGIN_DOC +! TODO + END_DOC + call dress_zmq() +end + + +! BEGIN_PROVIDER [ double precision, hij_cache_, (N_det,Nproc) ] +!&BEGIN_PROVIDER [ double precision, sij_cache_, (N_det,Nproc) ] + BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ] +&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ] + implicit none +! allocate(fock_diag_tmp(2,mo_tot_num+1)) + current_generator_(:) = 0 + END_PROVIDER + + + +subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) + use bitmasks + implicit none + BEGIN_DOC + !delta_ij_loc(:,:,1) : dressing column for H + !delta_ij_loc(:,:,2) : dressing column for S2 + !minilist : indices of determinants connected to alpha ( in psi_det_sorted ) + !n_minilist : size of minilist + !alpha : alpha determinant + END_DOC + integer(bit_kind), intent(in) :: alpha(N_int,2), det_minilist(N_int, 2, n_minilist) + integer,intent(in) :: minilist(n_minilist), n_minilist, iproc, i_gen + double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) + double precision :: hii, hij, sij, delta_e + double precision, external :: diag_H_mat_elem_fock + integer :: i,j,k,l,m, l_sd + + + if(current_generator_(iproc) /= i_gen) then + current_generator_(iproc) = i_gen + call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int) + end if + !return + hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) + + + do l_sd=1,n_minilist + call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) + do i=1,N_states + delta_ij_loc(i, minilist(l_sd), 1) += hij / hii * psi_coef(minilist(l_sd), i) + end do + end do +end subroutine + + + + + + From bc626377f389c9f1b40a1625584731314010e80f Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Mon, 5 Mar 2018 12:43:31 +0100 Subject: [PATCH 47/65] shiftedbk not working - may be removed later --- plugins/shiftedbk/shifted_bk.irp.f | 52 +++++++++++++++++++++++------- 1 file changed, 41 insertions(+), 11 deletions(-) diff --git a/plugins/shiftedbk/shifted_bk.irp.f b/plugins/shiftedbk/shifted_bk.irp.f index 12c867d6..4b9c7433 100644 --- a/plugins/shiftedbk/shifted_bk.irp.f +++ b/plugins/shiftedbk/shifted_bk.irp.f @@ -8,12 +8,9 @@ program mrcc_sto end -! BEGIN_PROVIDER [ double precision, hij_cache_, (N_det,Nproc) ] -!&BEGIN_PROVIDER [ double precision, sij_cache_, (N_det,Nproc) ] BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ] &BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ] implicit none -! allocate(fock_diag_tmp(2,mo_tot_num+1)) current_generator_(:) = 0 END_PROVIDER @@ -25,6 +22,7 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, BEGIN_DOC !delta_ij_loc(:,:,1) : dressing column for H !delta_ij_loc(:,:,2) : dressing column for S2 + !i_gen : generator index in psi_det_generators !minilist : indices of determinants connected to alpha ( in psi_det_sorted ) !n_minilist : size of minilist !alpha : alpha determinant @@ -35,21 +33,31 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, double precision :: hii, hij, sij, delta_e double precision, external :: diag_H_mat_elem_fock integer :: i,j,k,l,m, l_sd + double precision, save :: tot = 0d0 + double precision :: de(N_states), val, tmp + stop "shiftedbk currently does not work" if(current_generator_(iproc) /= i_gen) then current_generator_(iproc) = i_gen call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int) end if - !return - hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) - - do l_sd=1,n_minilist - call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) - do i=1,N_states - delta_ij_loc(i, minilist(l_sd), 1) += hij / hii * psi_coef(minilist(l_sd), i) + hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) + do i=1,N_states + de(i) = (E0_denominator(i) - hii) + end do + + do i=1,N_states + val = 0D0 + do l_sd=1,n_minilist + call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) + val += hij end do + val = 2d0 * val + tmp = dsqrt(de(i)**2 + val**2) + if(de(i) < 0d0) tmp = -tmp + delta_ij_loc(i, minilist(l_sd), 1) += 0.5d0 * (tmp - de(i)) ! * psi_coef(minilist(l_sd), i) end do end subroutine @@ -57,4 +65,26 @@ end subroutine - +BEGIN_PROVIDER [ logical, initialize_E0_denominator ] + implicit none + BEGIN_DOC + ! If true, initialize pt2_E0_denominator + END_DOC + initialize_E0_denominator = .True. +END_PROVIDER + +BEGIN_PROVIDER [ double precision, E0_denominator, (N_states) ] + implicit none + BEGIN_DOC + ! E0 in the denominator of the PT2 + END_DOC + if (initialize_E0_denominator) then + E0_denominator(1:N_states) = psi_energy(1:N_states) + ! call ezfio_get_full_ci_zmq_energy(pt2_E0_denominator(1)) + ! pt2_E0_denominator(1) -= nuclear_repulsion + ! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion + ! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) + else + E0_denominator = -huge(1.d0) + endif +END_PROVIDER From 8f6e7f4a4007ac5aafcde0018cca961bacec76ec Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 5 Mar 2018 17:04:26 +0100 Subject: [PATCH 48/65] Added Bk module --- plugins/Bk/EZFIO.cfg | 17 ++ plugins/Bk/NEEDED_CHILDREN_MODULES | 2 + plugins/Bk/README.rst | 12 + plugins/Bk/bk.irp.f | 26 ++ plugins/Bk/dressing.irp.f | 46 +++ plugins/DavidsonDressed/diagonalize_CI.irp.f | 106 ++----- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 2 +- plugins/Full_CI_ZMQ/selection.irp.f | 1 - .../set_as_holes_and_particles.irp.f} | 0 plugins/Psiref_Utils/psi_ref_utils.irp.f | 14 + plugins/dress_zmq/alpha_factory.irp.f | 13 +- plugins/dress_zmq/dress_general.irp.f | 76 +---- plugins/dress_zmq/dress_stoch_routines.irp.f | 267 +++++++++--------- plugins/dress_zmq/dress_zmq_routines.irp.f | 5 +- plugins/dress_zmq/dressing.irp.f | 42 ++- plugins/dress_zmq/dressing_vector.irp.f | 21 +- plugins/dress_zmq/energy.irp.f | 8 +- plugins/dress_zmq/run_dress_slave.irp.f | 10 +- plugins/mrcc_sto/mrcc_sto.irp.f | 2 +- src/Davidson/u0Hu0.irp.f | 7 +- 20 files changed, 333 insertions(+), 344 deletions(-) create mode 100644 plugins/Bk/EZFIO.cfg create mode 100644 plugins/Bk/NEEDED_CHILDREN_MODULES create mode 100644 plugins/Bk/README.rst create mode 100644 plugins/Bk/bk.irp.f create mode 100644 plugins/Bk/dressing.irp.f rename plugins/{MRCC_Utils/mrcc_general.irp.f => MRPT_Utils/set_as_holes_and_particles.irp.f} (100%) diff --git a/plugins/Bk/EZFIO.cfg b/plugins/Bk/EZFIO.cfg new file mode 100644 index 00000000..52d41568 --- /dev/null +++ b/plugins/Bk/EZFIO.cfg @@ -0,0 +1,17 @@ +[energy] +type: double precision +doc: Calculated energy +interface: ezfio + +[thresh_dressed_ci] +type: Threshold +doc: Threshold on the convergence of the dressed CI energy +interface: ezfio,provider,ocaml +default: 1.e-5 + +[n_it_max_dressed_ci] +type: Strictly_positive_int +doc: Maximum number of dressed CI iterations +interface: ezfio,provider,ocaml +default: 10 + diff --git a/plugins/Bk/NEEDED_CHILDREN_MODULES b/plugins/Bk/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..6bcca9aa --- /dev/null +++ b/plugins/Bk/NEEDED_CHILDREN_MODULES @@ -0,0 +1,2 @@ +Bitmask dress_zmq DavidsonDressed + diff --git a/plugins/Bk/README.rst b/plugins/Bk/README.rst new file mode 100644 index 00000000..7b379f8e --- /dev/null +++ b/plugins/Bk/README.rst @@ -0,0 +1,12 @@ +== +Bk +== + +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. diff --git a/plugins/Bk/bk.irp.f b/plugins/Bk/bk.irp.f new file mode 100644 index 00000000..254320f7 --- /dev/null +++ b/plugins/Bk/bk.irp.f @@ -0,0 +1,26 @@ +program bk + implicit none + BEGIN_DOC +! Shifted-Bk method + END_DOC + read_wf = .True. + state_following = .True. + TOUCH read_wf state_following + call run() +end + +subroutine run + implicit none + call diagonalize_ci_dressed + integer :: istate + print *, 'Bk Energy' + print *, '---------' + print *, '' + do istate = 1,N_states + print *, istate, CI_energy_dressed(istate) + enddo +! call save_wavefunction + call ezfio_set_bk_energy(ci_energy_dressed(1)) +end + + diff --git a/plugins/Bk/dressing.irp.f b/plugins/Bk/dressing.irp.f new file mode 100644 index 00000000..ffd308fa --- /dev/null +++ b/plugins/Bk/dressing.irp.f @@ -0,0 +1,46 @@ +subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, minilist, det_minilist, n_minilist, alpha, iproc) + use bitmasks + implicit none + BEGIN_DOC + !delta_ij_loc(:,:,1) : dressing column for H + !delta_ij_loc(:,:,2) : dressing column for S2 + !minilist : indices of determinants connected to alpha ( in psi_det_sorted ) + !n_minilist : size of minilist + !alpha : alpha determinant + END_DOC + integer, intent(in) :: Nint, Ndet, Nstates, n_minilist, iproc + integer(bit_kind), intent(in) :: alpha(Nint,2), det_minilist(Nint, 2, n_minilist) + integer,intent(in) :: minilist(n_minilist) + double precision, intent(inout) :: delta_ij_loc(Nstates,Ndet,2) + + integer :: j, j_mini, i_state + double precision :: c_alpha(N_states), h_alpha_alpha, hdress, sdress + double precision :: i_h_alpha, i_s_alpha, alpha_h_psi(N_states) + + double precision, external :: diag_H_mat_elem + + h_alpha_alpha = diag_h_mat_elem(alpha,N_int) + call i_H_psi_minilist(alpha,det_minilist,minilist,n_minilist,psi_coef,N_int,n_minilist,size(psi_coef,1),N_states,alpha_h_psi) + + do i_state=1,N_states + c_alpha(i_state) = alpha_h_psi(i_state) / & + (dress_e0_denominator(i_state) - h_alpha_alpha) + enddo + + do j_mini=1,n_minilist + j = minilist(j_mini) + call i_H_j (det_minilist(1,1,j_mini),alpha,N_int,i_h_alpha) + call get_s2(det_minilist(1,1,j_mini),alpha,N_int,i_s_alpha) + do i_state=1,N_states + hdress = c_alpha(i_state) * i_h_alpha + sdress = c_alpha(i_state) * i_s_alpha + delta_ij_loc(i_state,j,1) = delta_ij_loc(i_state,j,1) + hdress + delta_ij_loc(i_state,j,2) = delta_ij_loc(i_state,j,2) + sdress + enddo + enddo + + +end subroutine + + + diff --git a/plugins/DavidsonDressed/diagonalize_CI.irp.f b/plugins/DavidsonDressed/diagonalize_CI.irp.f index 7b12bc1c..3d1c1118 100644 --- a/plugins/DavidsonDressed/diagonalize_CI.irp.f +++ b/plugins/DavidsonDressed/diagonalize_CI.irp.f @@ -90,81 +90,31 @@ END_PROVIDER allocate (eigenvectors(size(H_matrix_dressed,1),N_det)) allocate (eigenvalues(N_det)) - call lapack_diag(eigenvalues,eigenvectors, & - H_matrix_dressed,size(H_matrix_dressed,1),N_det) - CI_electronic_energy_dressed(:) = 0.d0 - if (s2_eig) then - i_state = 0 - allocate (s2_eigvalues(N_det)) - allocate(index_good_state_array(N_det),good_state_array(N_det)) - good_state_array = .False. - call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int, & - N_det,size(eigenvectors,1)) - do j=1,N_det - ! Select at least n_states states with S^2 values closed to "expected_s2" - if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then - i_state +=1 - index_good_state_array(i_state) = j - good_state_array(j) = .True. - endif - if(i_state.eq.N_states) then - exit - endif + + do j=1,min(N_states,N_det) + do i=1,N_det + eigenvectors(i,j) = psi_coef(i,j) enddo - if(i_state .ne.0)then - ! Fill the first "i_state" states that have a correct S^2 value - do j = 1, i_state - do i=1,N_det - CI_eigenvectors_dressed(i,j) = eigenvectors(i,index_good_state_array(j)) - enddo - CI_electronic_energy_dressed(j) = eigenvalues(index_good_state_array(j)) - CI_eigenvectors_s2_dressed(j) = s2_eigvalues(index_good_state_array(j)) - enddo - i_other_state = 0 - do j = 1, N_det - if(good_state_array(j))cycle - i_other_state +=1 - if(i_state+i_other_state.gt.n_states_diag)then - exit - endif - do i=1,N_det - CI_eigenvectors_dressed(i,i_state+i_other_state) = eigenvectors(i,j) - enddo - CI_electronic_energy_dressed(i_state+i_other_state) = eigenvalues(j) - CI_eigenvectors_s2_dressed(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) - enddo - - else - print*,'' - print*,'!!!!!!!! WARNING !!!!!!!!!' - print*,' Within the ',N_det,'determinants selected' - print*,' and the ',N_states_diag,'states requested' - print*,' We did not find any state with S^2 values close to ',expected_s2 - print*,' We will then set the first N_states eigenvectors of the H matrix' - print*,' as the CI_eigenvectors_dressed' - print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space' - print*,'' - do j=1,min(N_states_diag,N_det) - do i=1,N_det - CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) - enddo - CI_electronic_energy_dressed(j) = eigenvalues(j) - CI_eigenvectors_s2_dressed(j) = s2_eigvalues(j) - enddo - endif - deallocate(index_good_state_array,good_state_array) - deallocate(s2_eigvalues) - else - call u_0_S2_u_0(CI_eigenvectors_s2_dressed,eigenvectors,N_det,psi_det,N_int,& - min(N_det,N_states_diag),size(eigenvectors,1)) - ! Select the "N_states_diag" states of lowest energy - do j=1,min(N_det,N_states_diag) + enddo + do mrcc_state=1,N_states + do j=mrcc_state,min(N_states,N_det) do i=1,N_det - CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) + eigenvectors(i,j) = psi_coef(i,j) enddo - CI_electronic_energy_dressed(j) = eigenvalues(j) enddo - endif + + call lapack_diag(eigenvalues,eigenvectors, & + H_matrix_dressed(1,1,mrcc_state),size(H_matrix_dressed,1),N_det) + CI_eigenvectors_dressed(1:N_det,mrcc_state) = eigenvectors(1:N_det,mrcc_state) + CI_electronic_energy_dressed(mrcc_state) = eigenvalues(mrcc_state) + enddo + do k=N_states+1,N_states_diag + CI_eigenvectors_dressed(1:N_det,k) = eigenvectors(1:N_det,k) + CI_electronic_energy_dressed(k) = eigenvalues(k) + enddo + call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,& + N_states_diag,size(CI_eigenvectors_dressed,1)) + deallocate(eigenvectors,eigenvalues) endif @@ -192,19 +142,19 @@ BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ] BEGIN_DOC ! Dressed H with Delta_ij END_DOC - integer :: i, j,istate,ii,jj - do istate = 1,N_states + integer :: i, j, ii,jj, dressing_state + do dressing_state = 1,N_states do j=1,N_det do i=1,N_det - h_matrix_dressed(i,j,istate) = h_matrix_all_dets(i,j) + h_matrix_dressed(i,j,dressing_state) = h_matrix_all_dets(i,j) enddo enddo - i = dressed_column_idx(istate) + i = dressed_column_idx(dressing_state) do j = 1, N_det - h_matrix_dressed(i,j,istate) += dressing_column_h(j,istate) - h_matrix_dressed(j,i,istate) += dressing_column_h(j,istate) + h_matrix_dressed(i,j,dressing_state) += dressing_column_h(j,dressing_state) + h_matrix_dressed(j,i,dressing_state) += dressing_column_h(j,dressing_state) enddo - h_matrix_dressed(i,i,istate) -= dressing_column_h(i,istate) + h_matrix_dressed(i,i,dressing_state) -= dressing_column_h(i,dressing_state) enddo END_PROVIDER diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 9d1c50d4..3d95d6b0 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -513,7 +513,7 @@ END_PROVIDER double precision :: norm_left, stato integer, external :: pt2_find - pt2_weight(1) = psi_coef_generators(1,pt2_stoch_istate)**2 + pt2_weight(1) = psi_coef_generators(1,pt2_stoch_istate)**2 pt2_cweight(1) = psi_coef_generators(1,pt2_stoch_istate)**2 do i=1,N_det_generators diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index acda9fa6..d4fae71a 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -5,7 +5,6 @@ BEGIN_PROVIDER [ integer, fragment_count ] BEGIN_DOC ! Number of fragments for the deterministic part END_DOC -! fragment_count = (elec_alpha_num-n_core_orb)*mo_tot_num fragment_count = (elec_alpha_num-n_core_orb)**2 END_PROVIDER diff --git a/plugins/MRCC_Utils/mrcc_general.irp.f b/plugins/MRPT_Utils/set_as_holes_and_particles.irp.f similarity index 100% rename from plugins/MRCC_Utils/mrcc_general.irp.f rename to plugins/MRPT_Utils/set_as_holes_and_particles.irp.f diff --git a/plugins/Psiref_Utils/psi_ref_utils.irp.f b/plugins/Psiref_Utils/psi_ref_utils.irp.f index 95c993f0..c59bbd9f 100644 --- a/plugins/Psiref_Utils/psi_ref_utils.irp.f +++ b/plugins/Psiref_Utils/psi_ref_utils.irp.f @@ -325,3 +325,17 @@ BEGIN_PROVIDER [double precision, ref_hamiltonian_matrix, (n_det_ref,n_det_ref)] enddo END_PROVIDER + +BEGIN_PROVIDER [ integer, idx_non_ref_from_sorted, (N_det) ] + implicit none + integer :: i,inpsisor + + idx_non_ref_from_sorted = 0 + + do i=1,N_det + inpsisor = psi_det_sorted_order(i) + if(inpsisor <= 0) stop "idx_non_ref_from_sorted" + idx_non_ref_from_sorted(inpsisor) = idx_non_ref_rev(i) + end do +END_PROVIDER + diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index f1a3a8e9..114d4dbb 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -20,19 +20,16 @@ subroutine alpha_callback(delta_ij_loc, i_generator, subset,iproc) end subroutine - BEGIN_PROVIDER [ integer, psi_from_sorted, (N_det) ] -&BEGIN_PROVIDER [ integer, idx_non_ref_from_sorted, (N_det) ] +BEGIN_PROVIDER [ integer, psi_from_sorted, (N_det) ] implicit none integer :: i,inpsisor - idx_non_ref_from_sorted = 0 psi_from_sorted = 0 do i=1,N_det psi_from_sorted(psi_det_sorted_order(i)) = i inpsisor = psi_det_sorted_order(i) if(inpsisor <= 0) stop "idx_non_ref_from_sorted" - idx_non_ref_from_sorted(inpsisor) = idx_non_ref_rev(i) end do END_PROVIDER @@ -41,7 +38,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index use bitmasks implicit none BEGIN_DOC -! WARNING /!\ : It is assumed that the generators and selectors are psi_det_sorted +! TODO END_DOC double precision,intent(inout) :: delta_ij_loc(N_states,N_det,2) @@ -379,6 +376,7 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index call alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexes, indexes_end, abuf, siz, iproc) !call dress_with_alpha_buffer(delta_ij_loc, minilist, interesting(0), abuf, n) + end if enddo if(s1 /= s2) monoBdo = .false. @@ -489,10 +487,7 @@ subroutine alpha_callback_mask(delta_ij_loc, sp, mask, bannedOrb, banned, indexe !APPLY PART if(st4 > 1) then call apply_particles(mask, s1, i, s2, j, alpha, ok, N_int) - !if(.not. ok) stop "non existing alpha......" - !print *, "willcall", st4-1, size(labuf) - call dress_with_alpha_buffer(delta_ij_loc, labuf, det_minilist, st4-1, alpha, iproc) - !call dress_with_alpha_buffer(delta_ij_loc, abuf, siz, alpha, 1) + call dress_with_alpha_buffer(N_states, N_det, N_int, delta_ij_loc, labuf, det_minilist, st4-1, alpha, iproc) end if end do diff --git a/plugins/dress_zmq/dress_general.irp.f b/plugins/dress_zmq/dress_general.irp.f index 29dc086d..0bf7e715 100644 --- a/plugins/dress_zmq/dress_general.irp.f +++ b/plugins/dress_zmq/dress_general.irp.f @@ -1,6 +1,6 @@ -subroutine run(N_st,energy) +subroutine run_dressing(N_st,energy) implicit none integer, intent(in) :: N_st @@ -13,8 +13,6 @@ subroutine run(N_st,energy) integer :: n_it_dress_max double precision :: thresh_dress - double precision, allocatable :: lambda(:) - allocate (lambda(N_states)) thresh_dress = thresh_dressed_ci n_it_dress_max = n_it_max_dressed_ci @@ -33,7 +31,6 @@ subroutine run(N_st,energy) E_new = 0.d0 delta_E = 1.d0 iteration = 0 - lambda = 1.d0 do while (delta_E > thresh_dress) iteration += 1 print *, '===============================================' @@ -44,7 +41,7 @@ subroutine run(N_st,energy) do i=1,N_st call write_double(6,ci_energy_dressed(i),"Energy") enddo - call diagonalize_ci_dressed(lambda) + call diagonalize_ci_dressed E_new = dress_e0_denominator(1) !sum(ci_energy_dressed(1:N_states)) delta_E = (E_new - E_old)/dble(N_states) @@ -63,72 +60,3 @@ subroutine run(N_st,energy) energy(1:N_st) = ci_energy_dressed(1:N_st) end - -subroutine print_cas_coefs - implicit none - - integer :: i,j - print *, 'CAS' - print *, '===' - do i=1,N_det_cas - print *, (psi_cas_coef(i,j), j=1,N_states) - call debug_det(psi_cas(1,1,i),N_int) - enddo - call write_double(6,ci_energy(1),"Initial CI energy") - -end - - -subroutine run_pt2(N_st,energy,pt2) - implicit none - integer :: i,j,k - integer, intent(in) :: N_st - double precision, intent(in) :: energy(N_st) - double precision :: pt2(N_st) - double precision :: norm_pert(N_st),H_pert_diag(N_st) - - pt2 = 0d0 - - print*,'Last iteration only to compute the PT2' - - N_det_generators = N_det_cas - N_det_selectors = N_det_non_ref - - do i=1,N_det_generators - do k=1,N_int - psi_det_generators(k,1,i) = psi_ref(k,1,i) - psi_det_generators(k,2,i) = psi_ref(k,2,i) - enddo - do k=1,N_st - psi_coef_generators(i,k) = psi_ref_coef(i,k) - enddo - enddo - do i=1,N_det - do k=1,N_int - psi_selectors(k,1,i) = psi_det_sorted(k,1,i) - psi_selectors(k,2,i) = psi_det_sorted(k,2,i) - enddo - do k=1,N_st - psi_selectors_coef(i,k) = psi_coef_sorted(i,k) - enddo - enddo - - SOFT_TOUCH N_det_selectors psi_selectors_coef psi_selectors N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed - SOFT_TOUCH psi_ref_coef_diagonalized psi_ref_energy_diagonalized - - call H_apply_mrcepa_PT2(pt2, norm_pert, H_pert_diag, N_st) - -! call ezfio_set_full_ci_energy_pt2(energy+pt2) - - print *, 'Final step' - print *, 'N_det = ', N_det - print *, 'N_states = ', N_states - print *, 'PT2 = ', pt2 - print *, 'E = ', energy - print *, 'E+PT2 = ', energy+pt2 - print *, '-----' - -! call ezfio_set_dress_zmq_energy_pt2(energy(1)+pt2(1)) - -end - diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 3c2877ab..c2557758 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -10,10 +10,10 @@ subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) implicit none character(len=64000) :: task - + integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull integer, external :: omp_get_thread_num - double precision, intent(in) :: relative_error, E + double precision, intent(in) :: E(N_states), relative_error double precision, intent(out) :: dress(N_states) double precision, intent(out) :: delta(N_states, N_det) double precision, intent(out) :: delta_s2(N_states, N_det) @@ -23,106 +23,112 @@ subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) double precision, external :: omp_get_wtime double precision :: time - double precision :: w(N_states) - integer, external :: add_task_to_taskserver - - - provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral dress_weight psi_selectors - - !!!!!!!!!!!!!!! demander a TOTO !!!!!!! - w(:) = 0.d0 - w(dress_stoch_istate) = 1.d0 - !call update_psi_average_norm_contrib(w) + integer, external :: add_task_to_taskserver + double precision :: state_average_weight_save(N_states) - - - print *, '========== ================= ================= =================' - print *, ' Samples Energy Stat. Error Seconds ' - print *, '========== ================= ================= =================' - - - call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull, 'dress') - - integer, external :: zmq_put_psi - integer, external :: zmq_put_N_det_generators - integer, external :: zmq_put_N_det_selectors - integer, external :: zmq_put_dvector - integer, external :: zmq_set_running - if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then - stop 'Unable to put psi on ZMQ server' - endif - if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_generators on ZMQ server' - endif - if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_selectors on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',dress_e0_denominator,size(dress_e0_denominator)) == -1) then - stop 'Unable to put energy on ZMQ server' - endif - - integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket - integer :: ipos - ipos=1 - do i=1,N_dress_jobs - if(dress_jobs(i) > fragment_first) then - write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') 0, dress_jobs(i) - ipos += 20 - if (ipos > 63980) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - - ipos=1 - endif - else - do j=1,fragment_count - write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') j, dress_jobs(i) + state_average_weight_save(:) = state_average_weight(:) + do dress_stoch_istate=1,N_states + SOFT_TOUCH dress_stoch_istate + state_average_weight(:) = 0.d0 + state_average_weight(dress_stoch_istate) = 1.d0 + TOUCH state_average_weight + + provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral dress_weight psi_selectors + + + print *, '========== ================= ================= =================' + print *, ' Samples Energy Stat. Error Seconds ' + print *, '========== ================= ================= =================' + + + call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull, 'dress') + + integer, external :: zmq_put_psi + integer, external :: zmq_put_N_det_generators + integer, external :: zmq_put_N_det_selectors + integer, external :: zmq_put_dvector + integer, external :: zmq_set_running + if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then + stop 'Unable to put psi on ZMQ server' + endif + if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_generators on ZMQ server' + endif + if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_selectors on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',dress_e0_denominator,size(dress_e0_denominator)) == -1) then + stop 'Unable to put energy on ZMQ server' + endif + + integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket + integer :: ipos + ipos=1 + do i=1,N_dress_jobs + if(dress_jobs(i) > fragment_first) then + write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') 0, dress_jobs(i) ipos += 20 if (ipos > 63980) then if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then stop 'Unable to add task to task server' endif + ipos=1 endif - end do - end if - end do - if (ipos > 1) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - endif - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' + else + do j=1,fragment_count + write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') j, dress_jobs(i) + ipos += 20 + if (ipos > 63980) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + ipos=1 + endif + end do + end if + end do + if (ipos > 1) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' endif - - !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) & - !$OMP PRIVATE(i) - i = omp_get_thread_num() - if (i==0) then - call dress_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, dress) - else - call dress_slave_inproc(i) - endif - !$OMP END PARALLEL - call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'dress') + endif + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + + !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) & + !$OMP PRIVATE(i) + i = omp_get_thread_num() + if (i==0) then + call dress_collector(zmq_socket_pull,E, relative_error, delta, delta_s2, dress,& + dress_stoch_istate) + else + call dress_slave_inproc(i) + endif + !$OMP END PARALLEL + call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'dress') + + print *, '========== ================= ================= =================' + enddo + FREE dress_stoch_istate + state_average_weight(:) = state_average_weight_save(:) + TOUCH state_average_weight - print *, '========== ================= ================= =================' end subroutine subroutine dress_slave_inproc(i) implicit none integer, intent(in) :: i - + call run_dress_slave(1,i,dress_e0_denominator) end -subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, dress) +subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, dress, istate) use f77_zmq use bitmasks implicit none @@ -130,8 +136,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, integer(ZMQ_PTR), intent(in) :: zmq_socket_pull + integer, intent(in) :: istate - double precision, intent(in) :: relative_error, E + double precision, intent(in) :: relative_error, E(N_states) double precision, intent(out) :: dress(N_states) double precision, allocatable :: cp(:,:,:,:) @@ -197,9 +204,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, !!!!! A VERIFIER !!!!! do i_state=1,N_states - do i=1, N_det - dress_mwen(i_state) += delta_loc(i_state, i, 1) * psi_coef(i, i_state) - end do + do i=1, N_det + dress_mwen(i_state) += delta_loc(i_state, i, 1) * psi_coef(i, i_state) + end do end do dress_detail(:, ind) += dress_mwen(:) @@ -210,12 +217,8 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, integer :: toothMwen logical :: fracted fac = cps(ind, j) / cps_N(j) * dress_weight_inv(ind) * comb_step - do k=1,N_det - do i_state=1,N_states - cp(i_state,k,j,1) += delta_loc(i_state,k,1) * fac - cp(i_state,k,j,2) += delta_loc(i_state,k,2) * fac - end do - end do + cp(1:N_states,1:N_det,j,1) += delta_loc(1:N_states,1:N_det,1) * fac + cp(1:N_states,1:N_det,j,2) += delta_loc(1:N_states,1:N_det,2) * fac end if end do toothMwen = tooth_of_det(ind) @@ -223,13 +226,13 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, if(fracted) fracted = (ind == first_det_of_teeth(toothMwen)) if(fracted) then - delta_det(:,:,toothMwen-1, 1) += delta_loc(:,:,1) * (1d0-fractage(toothMwen)) - delta_det(:,:,toothMwen-1, 2) += delta_loc(:,:,2) * (1d0-fractage(toothMwen)) - delta_det(:,:,toothMwen, 1) += delta_loc(:,:,1) * (fractage(toothMwen)) - delta_det(:,:,toothMwen, 2) += delta_loc(:,:,2) * (fractage(toothMwen)) + delta_det(1:N_states,1:N_det,toothMwen-1, 1) = delta_det(1:N_states,1:N_det,toothMwen-1, 1) + delta_loc(1:N_states,1:N_det,1) * (1d0-fractage(toothMwen)) + delta_det(1:N_states,1:N_det,toothMwen-1, 2) = delta_det(1:N_states,1:N_det,toothMwen-1, 2) + delta_loc(1:N_states,1:N_det,2) * (1d0-fractage(toothMwen)) + delta_det(1:N_states,1:N_det,toothMwen , 1) = delta_det(1:N_states,1:N_det,toothMwen , 1) + delta_loc(1:N_states,1:N_det,1) * (fractage(toothMwen)) + delta_det(1:N_states,1:N_det,toothMwen , 2) = delta_det(1:N_states,1:N_det,toothMwen , 2) + delta_loc(1:N_states,1:N_det,2) * (fractage(toothMwen)) else - delta_det(:,:,toothMwen, 1) += delta_loc(:,:,1) - delta_det(:,:,toothMwen, 2) += delta_loc(:,:,2) + delta_det(1:N_states,1:N_det,toothMwen , 1) = delta_det(1:N_states,1:N_det,toothMwen , 1) + delta_loc(1:N_states,1:N_det,1) + delta_det(1:N_states,1:N_det,toothMwen , 2) = delta_det(1:N_states,1:N_det,toothMwen , 2) + delta_loc(1:N_states,1:N_det,2) end if parts_to_get(ind) -= 1 @@ -265,25 +268,24 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, double precision :: su, su2, eqt, avg, E0, val integer, external :: zmq_abort - su = 0d0 + su = 0d0 su2 = 0d0 do i=1, int(cps_N(cur_cp)) - call get_comb_val(comb(i), dress_detail, cur_cp, val) - su += val - su2 += val**2 + call get_comb_val(comb(i), dress_detail, cur_cp, val, istate) + su += val + su2 += val*val end do avg = su / cps_N(cur_cp) - eqt = dsqrt( ((su2 / cps_N(cur_cp)) - avg**2) / cps_N(cur_cp) ) - E0 = sum(dress_detail(1, :first_det_of_teeth(cp_first_tooth(cur_cp))-1)) + eqt = dsqrt( ((su2 / cps_N(cur_cp)) - avg*avg) / cps_N(cur_cp) ) + E0 = sum(dress_detail(istate, :first_det_of_teeth(cp_first_tooth(cur_cp))-1)) if(cp_first_tooth(cur_cp) <= comb_teeth) then - E0 = E0 + dress_detail(1, first_det_of_teeth(cp_first_tooth(cur_cp))) * (1d0-fractage(cp_first_tooth(cur_cp))) + E0 = E0 + dress_detail(istate, first_det_of_teeth(cp_first_tooth(cur_cp))) * (1d0-fractage(cp_first_tooth(cur_cp))) end if call wall_time(time) - if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then + if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 5) .or. total_computed == N_det_generators) then ! Termination - !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' -! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed + print '(2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', avg+E(istate)+E0, eqt, time-time0, '' if (zmq_abort(zmq_to_qp_run_socket) == -1) then call sleep(1) if (zmq_abort(zmq_to_qp_run_socket) == -1) then @@ -293,31 +295,30 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, else if (cur_cp > old_cur_cp) then old_cur_cp = cur_cp -! print *, "GREPME", cur_cp, E+E0+avg, eqt, time-time0, total_computed - !print '(G10.3, 2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' + print '(2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', avg+E(istate)+E0, eqt, time-time0, '' endif endif end if end do pullLoop if(total_computed == N_det_generators) then - delta = 0d0 - delta_s2 = 0d0 + delta (1:N_states,1:N_det) = 0d0 + delta_s2(1:N_states,1:N_det) = 0d0 do i=comb_teeth+1,0,-1 - delta += delta_det(:,:,i,1) - delta_s2 += delta_det(:,:,i,2) + delta (1:N_states,1:N_det) = delta (1:N_states,1:N_det) + delta_det(1:N_states,1:N_det,i,1) + delta_s2(1:N_states,1:N_det) = delta_s2(1:N_states,1:N_det) + delta_det(1:N_states,1:N_det,i,2) end do else - delta = cp(:,:,cur_cp,1) - delta_s2 = cp(:,:,cur_cp,2) + delta (1:N_states,1:N_det) = cp(1:N_states,1:N_det,cur_cp,1) + delta_s2(1:N_states,1:N_det) = cp(1:N_states,1:N_det,cur_cp,2) do i=cp_first_tooth(cur_cp)-1,0,-1 - delta += delta_det(:,:,i,1) - delta_s2 += delta_det(:,:,i,2) + delta (1:N_states,1:N_det) = delta (1:N_states,1:N_det) + delta_det(1:N_states,1:N_det,i,1) + delta_s2(1:N_states,1:N_det) = delta_s2(1:N_states,1:N_det) + delta_det(1:N_states,1:N_det,i,2) end do end if - dress(1) = E + dress(istate) = E(istate)+E0 call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) end subroutine @@ -353,10 +354,14 @@ end function &BEGIN_PROVIDER [ integer, comb_teeth ] &BEGIN_PROVIDER [ integer, N_cps_max ] implicit none - comb_teeth = 16 - N_cps_max = 32 + BEGIN_DOC +! N_cps_max : max number of checkpoints +! +! gen_per_cp : number of generators per checkpoint + END_DOC + comb_teeth = 64 + N_cps_max = 64 gen_per_cp = (N_det_generators / N_cps_max) + 1 - N_cps_max += 1 END_PROVIDER @@ -457,9 +462,9 @@ END_PROVIDER END_PROVIDER -subroutine get_comb_val(stato, detail, cur_cp, val) +subroutine get_comb_val(stato, detail, cur_cp, val, istate) implicit none - integer, intent(in) :: cur_cp + integer, intent(in) :: cur_cp, istate integer :: first double precision, intent(in) :: stato, detail(N_states, N_det_generators) double precision, intent(out) :: val @@ -475,9 +480,9 @@ subroutine get_comb_val(stato, detail, cur_cp, val) !DIR$ FORCEINLINE k = dress_find(curs, dress_cweight,size(dress_cweight), first_det_of_teeth(j), first_det_of_teeth(j+1)) if(k == first_det_of_teeth(first)) then - val += detail(1, k) * dress_weight_inv(k) * comb_step * fractage(first) + val += detail(istate, k) * dress_weight_inv(k) * comb_step * fractage(first) else - val += detail(1, k) * dress_weight_inv(k) * comb_step + val += detail(istate, k) * dress_weight_inv(k) * comb_step end if curs -= comb_step @@ -528,10 +533,10 @@ subroutine add_comb(com, computed, cp, N, tbc) end subroutine - BEGIN_PROVIDER [ integer, dress_stoch_istate ] - implicit none - dress_stoch_istate = 1 - END_PROVIDER +BEGIN_PROVIDER [ integer, dress_stoch_istate ] + implicit none + dress_stoch_istate = 1 +END_PROVIDER BEGIN_PROVIDER [ double precision, dress_weight, (N_det_generators) ] @@ -548,7 +553,7 @@ end subroutine double precision :: norm_left, stato integer, external :: dress_find - dress_weight(1) = psi_coef_generators(1,dress_stoch_istate)**2 + dress_weight(1) = psi_coef_generators(1,dress_stoch_istate)**2 dress_cweight(1) = psi_coef_generators(1,dress_stoch_istate)**2 do i=1,N_det_generators @@ -575,8 +580,8 @@ end subroutine comb_step = 1d0/dfloat(comb_teeth) first_det_of_comb = 1 - do i=1,N_det_generators - if(dress_weight(i)/norm_left < .25d0*comb_step) then + do i=1,min(100,N_det_generators) + if(dress_weight(i)/norm_left < comb_step) then first_det_of_comb = i exit end if diff --git a/plugins/dress_zmq/dress_zmq_routines.irp.f b/plugins/dress_zmq/dress_zmq_routines.irp.f index a18bc882..4dc75236 100644 --- a/plugins/dress_zmq/dress_zmq_routines.irp.f +++ b/plugins/dress_zmq/dress_zmq_routines.irp.f @@ -15,10 +15,7 @@ subroutine dress_zmq() enddo SOFT_TOUCH psi_coef endif - call run(N_states,energy) - if(do_pt2)then - call run_pt2(N_states,energy) - endif + call run_dressing(N_states,energy) deallocate(energy) end diff --git a/plugins/dress_zmq/dressing.irp.f b/plugins/dress_zmq/dressing.irp.f index 1736cc76..f835ffbf 100644 --- a/plugins/dress_zmq/dressing.irp.f +++ b/plugins/dress_zmq/dressing.irp.f @@ -5,9 +5,9 @@ BEGIN_PROVIDER [ integer, N_dress_teeth ] N_dress_teeth = 10 END_PROVIDER -BEGIN_PROVIDER [ double precision, dress_norm_acc, (0:N_det_non_ref, N_states) ] -&BEGIN_PROVIDER [ double precision, dress_norm, (0:N_det_non_ref, N_states) ] -&BEGIN_PROVIDER [ double precision, dress_teeth_size, (0:N_det_non_ref, N_states) ] +BEGIN_PROVIDER [ double precision, dress_norm_acc, (0:N_det, N_states) ] +&BEGIN_PROVIDER [ double precision, dress_norm, (0:N_det, N_states) ] +&BEGIN_PROVIDER [ double precision, dress_teeth_size, (0:N_det, N_states) ] &BEGIN_PROVIDER [ integer, dress_teeth, (0:N_dress_teeth+1, N_states) ] implicit none integer :: i, j, st, nt @@ -43,11 +43,11 @@ BEGIN_PROVIDER [ double precision, dress_norm_acc, (0:N_det_non_ref, N_states) ] end if end do if(nt > N_dress_teeth+1) then - print *, "foireouse dress_teeth", nt, dress_teeth(nt,st), N_det_non_ref + print *, "foireouse dress_teeth", nt, dress_teeth(nt,st), N_det stop end if - dress_teeth(N_dress_teeth+1,st) = N_det_non_ref+1 + dress_teeth(N_dress_teeth+1,st) = N_det+1 norm_loc = 0d0 do i=N_dress_teeth, 0, -1 dress_teeth_size(i,st) = dress_norm_acc(dress_teeth(i+1,st)-1,st) - dress_norm_acc(dress_teeth(i,st)-1, st) @@ -64,39 +64,37 @@ END_PROVIDER - BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ] +BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ] use bitmasks implicit none integer :: i,j,k double precision, allocatable :: dress(:), del(:,:), del_s2(:,:) - double precision :: E_CI_before, relative_error - double precision, save :: errr = 0d0 + double precision :: E_CI_before(N_states), relative_error +! double precision, save :: errr = 0d0 allocate(dress(N_states), del(N_states, N_det), del_s2(N_states, N_det)) delta_ij = 0d0 - E_CI_before = dress_E0_denominator(1) + nuclear_repulsion + E_CI_before(:) = dress_E0_denominator(:) + nuclear_repulsion threshold_selectors = 1.d0 threshold_generators = 1d0 - if(errr /= 0d0) then - errr = errr / 2d0 - else - errr = 1d-4 - end if - relative_error = errr * 0d0 - print *, "RELATIVE ERROR", relative_error +! if(errr /= 0d0) then +! errr = errr / 2d0 +! else +! errr = 1d-4 +! end if + relative_error = 1.d-3 + call write_double(6,relative_error,"Convergence of the stochastic algorithm") + call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error)) - delta_ij(:,:,1) = del(:,:) - !delta_ij_s2(:,:,1) = del_s2(:,:) delta_ij(:,:,2) = del_s2(:,:) - !do i=N_det,1,-1 - ! delta_ii(dress_stoch_istate,1) -= delta_ij(dress_stoch_istate, i, 1) / psi_ref_coef(1,dress_stoch_istate) * psi_coef(i, dress_stoch_istate) - ! delta_ii_s2(dress_stoch_istate,1) -= delta_ij_s2(dress_stoch_istate, i, 1) / psi_ref_coef(1,dress_stoch_istate) * psi_coef(i, dress_stoch_istate) - !end do + + deallocate(dress, del, del_s2) + END_PROVIDER diff --git a/plugins/dress_zmq/dressing_vector.irp.f b/plugins/dress_zmq/dressing_vector.irp.f index d3e465bd..494e7c4b 100644 --- a/plugins/dress_zmq/dressing_vector.irp.f +++ b/plugins/dress_zmq/dressing_vector.irp.f @@ -5,25 +5,28 @@ BEGIN_DOC ! Null dressing vectors END_DOC - dressing_column_h(:,:) = 0.d0 - dressing_column_s(:,:) = 0.d0 - integer :: i,ii,k,j,jj, l + integer :: i,ii,k,j, l double precision :: f, tmp double precision, external :: u_dot_v + dressing_column_h(:,:) = 0.d0 + dressing_column_s(:,:) = 0.d0 + do k=1,N_states l = dressed_column_idx(k) f = 1.d0/psi_coef(l,k) - do jj = 1, n_det - j = jj !idx_non_ref(jj) - dressing_column_h(j,k) = delta_ij (k,jj,1) * f - dressing_column_s(j,k) = delta_ij (k,jj,2) * f!delta_ij_s2(k,jj) + do j = 1, n_det + dressing_column_h(j,k) = delta_ij(k,j,1) * f + dressing_column_s(j,k) = delta_ij(k,j,2) * f enddo - tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) + tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) & + - dressing_column_h(l,k) * psi_coef(l,k) dressing_column_h(l,k) -= tmp * f - tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) + tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) & + - dressing_column_s(l,k) * psi_coef(l,k) dressing_column_s(l,k) -= tmp * f enddo + END_PROVIDER diff --git a/plugins/dress_zmq/energy.irp.f b/plugins/dress_zmq/energy.irp.f index 0ab170f1..b8948219 100644 --- a/plugins/dress_zmq/energy.irp.f +++ b/plugins/dress_zmq/energy.irp.f @@ -11,10 +11,12 @@ BEGIN_PROVIDER [ double precision, dress_E0_denominator, (N_states) ] BEGIN_DOC ! E0 in the denominator of the dress END_DOC + integer :: i if (initialize_dress_E0_denominator) then - dress_E0_denominator(1:N_states) = psi_energy(1:N_states) -! dress_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion -! dress_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) + call u_0_H_u_0(dress_E0_denominator,psi_coef,N_det,psi_det,N_int,N_states,size(psi_coef,1)) + do i=N_det+1,N_states + dress_E0_denominator(i) = 0.d0 + enddo call write_double(6,dress_E0_denominator(1)+nuclear_repulsion, 'dress Energy denominator') else dress_E0_denominator = -huge(1.d0) diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index 08d8af3d..b0896c00 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -46,7 +46,7 @@ subroutine run_dress_slave(thread,iproc,energy) return end if do i=1,N_states - div(i) = psi_ref_coef(dressed_column_idx(i), i) + div(i) = psi_coef(dressed_column_idx(i), i) end do do call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) @@ -56,14 +56,6 @@ subroutine run_dress_slave(thread,iproc,energy) delta_ij_loc = 0d0 call alpha_callback(delta_ij_loc, i_generator, subset, iproc) - !!! SET DRESSING COLUMN? - !do i=1,N_det - ! do i_state=1,N_states - ! delta_ij_loc(i_state,i,1) = delta_ij_loc(i_state,i,1) / div(i_state) - ! delta_ij_loc(i_state,i,2) = delta_ij_loc(i_state,i,2) / div(i_state) - ! end do - !end do - call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) call push_dress_results(zmq_socket_push, i_generator, delta_ij_loc, task_id) else diff --git a/plugins/mrcc_sto/mrcc_sto.irp.f b/plugins/mrcc_sto/mrcc_sto.irp.f index b8392f7f..cb92e3fa 100644 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ b/plugins/mrcc_sto/mrcc_sto.irp.f @@ -16,7 +16,7 @@ end &BEGIN_PROVIDER [ integer, excs_ , (0:2,2,2,N_det,Nproc) ] &BEGIN_PROVIDER [ double precision, phases_, (N_det, Nproc) ] BEGIN_DOC - ! temporay arrays for dress_with_alpha_buffer. Avoids realocation. + ! temporay arrays for dress_with_alpha_buffer. Avoids reallocation. END_DOC END_PROVIDER diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index dc020fc9..3e5610c8 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -483,8 +483,11 @@ subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze) call H_S2_u_0_nstates_zmq(v_0,s_0,u_1,N_states_diag,sze) deallocate(u_1) else - allocate (v_0(sze,N_st),s_0(sze,N_st)) - call H_S2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze) + allocate (v_0(n,N_st),s_0(n,N_st),u_1(n,N_st)) + u_1(1:n,:) = u_0(1:n,:) + call H_S2_u_0_nstates_openmp(v_0,s_0,u_1,N_st,n) + u_0(1:n,:) = u_1(1:n,:) + deallocate(u_1) endif double precision :: norm do i=1,N_st From 5dabd614f8d0bc845330fa721acc66517aeb4039 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 7 Mar 2018 19:01:19 +0100 Subject: [PATCH 49/65] Bk --- plugins/Bk/dressing.irp.f | 27 +++++++++++++++++++---- plugins/shiftedbk/NEEDED_CHILDREN_MODULES | 2 +- plugins/shiftedbk/shifted_bk.irp.f | 10 ++++----- 3 files changed, 29 insertions(+), 10 deletions(-) diff --git a/plugins/Bk/dressing.irp.f b/plugins/Bk/dressing.irp.f index 7ad7c362..0fbefda5 100644 --- a/plugins/Bk/dressing.irp.f +++ b/plugins/Bk/dressing.irp.f @@ -1,3 +1,13 @@ + BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ] +&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ] + implicit none + BEGIN_DOC +! Temporary arrays for speedup + END_DOC + current_generator_(:) = 0 + END_PROVIDER + + subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) use bitmasks implicit none @@ -17,14 +27,23 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili double precision :: c_alpha(N_states), h_alpha_alpha, hdress, sdress double precision :: i_h_alpha, i_s_alpha, alpha_h_psi(N_states) - double precision, external :: diag_H_mat_elem + double precision, external :: diag_H_mat_elem_fock - h_alpha_alpha = diag_h_mat_elem(alpha,N_int) + if(current_generator_(iproc) /= i_gen) then + current_generator_(iproc) = i_gen + call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int) + end if + + h_alpha_alpha = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) call i_H_psi_minilist(alpha,det_minilist,minilist,n_minilist,psi_coef,N_int,n_minilist,size(psi_coef,1),N_states,alpha_h_psi) do i_state=1,N_states - c_alpha(i_state) = alpha_h_psi(i_state) / & - (dress_e0_denominator(i_state) - h_alpha_alpha) + if (h_alpha_alpha - dress_e0_denominator(i_state) > 0.1d0 ) then + c_alpha(i_state) = alpha_h_psi(i_state) / & + (dress_e0_denominator(i_state) - h_alpha_alpha) + else + c_alpha(i_state) = 0.d0 + endif enddo do j_mini=1,n_minilist diff --git a/plugins/shiftedbk/NEEDED_CHILDREN_MODULES b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES index 5d17e71f..bebf68a2 100644 --- a/plugins/shiftedbk/NEEDED_CHILDREN_MODULES +++ b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -dress_zmq +dress_zmq DavidsonDressed MRCC_Utils diff --git a/plugins/shiftedbk/shifted_bk.irp.f b/plugins/shiftedbk/shifted_bk.irp.f index 4b9c7433..a2826aae 100644 --- a/plugins/shiftedbk/shifted_bk.irp.f +++ b/plugins/shiftedbk/shifted_bk.irp.f @@ -16,7 +16,7 @@ end -subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) +subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) use bitmasks implicit none BEGIN_DOC @@ -27,16 +27,16 @@ subroutine dress_with_alpha_buffer(delta_ij_loc, i_gen, minilist, det_minilist, !n_minilist : size of minilist !alpha : alpha determinant END_DOC - integer(bit_kind), intent(in) :: alpha(N_int,2), det_minilist(N_int, 2, n_minilist) - integer,intent(in) :: minilist(n_minilist), n_minilist, iproc, i_gen - double precision, intent(inout) :: delta_ij_loc(N_states,N_det,2) + integer, intent(in) :: Nint, Ndet, Nstates, n_minilist, iproc, i_gen + integer(bit_kind), intent(in) :: alpha(Nint,2), det_minilist(Nint, 2, n_minilist) + integer,intent(in) :: minilist(n_minilist) + double precision, intent(inout) :: delta_ij_loc(Nstates,N_det,2) double precision :: hii, hij, sij, delta_e double precision, external :: diag_H_mat_elem_fock integer :: i,j,k,l,m, l_sd double precision, save :: tot = 0d0 double precision :: de(N_states), val, tmp - stop "shiftedbk currently does not work" if(current_generator_(iproc) /= i_gen) then current_generator_(iproc) = i_gen From b29fb01e6f75039ee4096f5e51fba5d57a42cf95 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 11 Mar 2018 19:30:24 +0100 Subject: [PATCH 50/65] Trying to fix jbuilder bug in OCaml installation (#65) --- install/scripts/install_ocaml.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/scripts/install_ocaml.sh b/install/scripts/install_ocaml.sh index 9e8a2b25..91099fa2 100755 --- a/install/scripts/install_ocaml.sh +++ b/install/scripts/install_ocaml.sh @@ -5,7 +5,7 @@ QP_ROOT=$PWD cd - # Normal installation -PACKAGES="core.v0.10.0 cryptokit ocamlfind sexplib.v0.10.0 ZMQ ppx_sexp_conv ppx_deriving" +PACKAGES="core.v0.10.0 cryptokit ocamlfind sexplib.v0.10.0 ZMQ ppx_sexp_conv ppx_deriving jbuilder.1.0+beta17" # Needed for ZeroMQ export C_INCLUDE_PATH="${QP_ROOT}"/include:"${C_INCLUDE_PATH}" From 7e7080dba323f6e50f7eb7c178dec5bf5d372a85 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 14 Mar 2018 10:09:09 +0100 Subject: [PATCH 51/65] Added AVnZ-BFD --- data/basis/av5z-bfd | 956 +++++++++++++++++++++++++++++++++++++++ data/basis/avdz-bfd | 804 +++++++++++++++++++++++++++++++++ data/basis/avqz-bfd | 988 ++++++++++++++++++++++++++++++++++++++++ data/basis/avtz-bfd | 1038 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 3786 insertions(+) create mode 100644 data/basis/av5z-bfd create mode 100644 data/basis/avdz-bfd create mode 100644 data/basis/avqz-bfd create mode 100644 data/basis/avtz-bfd diff --git a/data/basis/av5z-bfd b/data/basis/av5z-bfd new file mode 100644 index 00000000..4f6128c3 --- /dev/null +++ b/data/basis/av5z-bfd @@ -0,0 +1,956 @@ +NEON +S 9 + 1 0.205835 0.057514 + 2 0.391384 0.215776 + 3 0.744196 0.374799 + 4 1.415048 0.326313 + 5 2.690638 0.166383 + 6 5.116103 -0.039149 + 7 9.727994 -0.085909 + 8 18.497256 0.006816 + 9 35.171534 0.000206 +S 1 + 1 0.318678 1.000000 +S 1 + 1 0.830178 1.000000 +S 1 + 1 1.591904 1.000000 +S 1 + 1 2.744999 1.000000 +P 9 + 1 0.121772 0.029943 + 2 0.238248 0.114200 + 3 0.466136 0.219618 + 4 0.912002 0.268864 + 5 1.784344 0.256932 + 6 3.491095 0.191378 + 7 6.830378 0.112176 + 8 13.363732 0.063317 + 9 26.146332 0.008057 +P 1 + 1 0.218226 1.000000 +P 1 + 1 0.636921 1.000000 +P 1 + 1 1.888191 1.000000 +P 1 + 1 3.020108 1.000000 +D 1 + 1 0.654924 1.000000 +D 1 + 1 1.931502 1.000000 +D 1 + 1 5.027566 1.000000 +D 1 + 1 6.989700 1.000000 +F 1 + 1 1.314297 1.000000 +F 1 + 1 4.065928 1.000000 +F 1 + 1 5.587487 1.000000 +G 1 + 1 2.070925 1.000000 +G 1 + 1 6.073107 1.000000 +H 1 + 1 3.743118 1.000000 +S 1 + 1 0.0957000 1.0000000 +P 1 + 1 0.0654000 1.0000000 +D 1 + 1 0.2130000 1.0000000 +F 1 + 1 0.4250000 1.0000000 +G 1 + 1 0.8090000 1.0000000 +H 1 + 1 1.6280000 1.0000000 + +BORON +S 9 + 1 0.040569 0.032031 + 2 0.081044 0.243317 + 3 0.161898 0.434636 + 4 0.323418 0.329581 + 5 0.646080 0.111875 + 6 1.290648 -0.078699 + 7 2.578276 -0.098781 + 8 5.150520 0.016164 + 9 10.288990 -0.000016 +S 1 + 1 0.070664 1.000000 +S 1 + 1 0.170896 1.000000 +S 1 + 1 0.375720 1.000000 +S 1 + 1 0.614105 1.000000 +P 9 + 1 0.029207 0.019909 + 2 0.058408 0.141775 + 3 0.116803 0.294463 + 4 0.233582 0.309028 + 5 0.467115 0.236378 + 6 0.934132 0.131317 + 7 1.868068 0.066454 + 8 3.735743 0.021248 + 9 7.470701 0.002837 +P 1 + 1 0.057917 1.000000 +P 1 + 1 0.143772 1.000000 +P 1 + 1 0.436327 1.000000 +P 1 + 1 0.566611 1.000000 +D 1 + 1 0.134838 1.000000 +D 1 + 1 0.380163 1.000000 +D 1 + 1 0.808233 1.000000 +D 1 + 1 1.022256 1.000000 +F 1 + 1 0.272717 1.000000 +F 1 + 1 0.799174 1.000000 +F 1 + 1 1.002171 1.000000 +G 1 + 1 0.486131 1.000000 +G 1 + 1 0.824366 1.000000 +H 1 + 1 0.632779 1.000000 +S 1 + 1 0.0261000 1.0000000 +P 1 + 1 0.0157000 1.0000000 +D 1 + 1 0.0431000 1.0000000 +F 1 + 1 0.0843000 1.0000000 +G 1 + 1 0.2020000 1.0000000 +H 1 + 1 0.3840000 1.0000000 + +ALUMINUM +S 9 + 1 0.045518 0.206193 + 2 0.100308 0.559887 + 3 0.221051 0.407852 + 4 0.487132 -0.041098 + 5 1.073500 -0.238652 + 6 2.365686 0.038132 + 7 5.213294 -0.003935 + 8 11.488606 0.000470 + 9 25.317597 -0.000014 +S 1 + 1 0.056415 1.000000 +S 1 + 1 0.155063 1.000000 +S 1 + 1 0.332041 1.000000 +S 1 + 1 0.725343 1.000000 +P 9 + 1 0.014848 0.009932 + 2 0.030967 0.160212 + 3 0.064586 0.389171 + 4 0.134700 0.373235 + 5 0.280932 0.195800 + 6 0.585913 0.022947 + 7 1.221985 -0.053293 + 8 2.548578 0.004846 + 9 5.315330 -0.000726 +P 1 + 1 0.033949 1.000000 +P 1 + 1 0.083154 1.000000 +P 1 + 1 0.251360 1.000000 +P 1 + 1 0.314422 1.000000 +D 1 + 1 0.088651 1.000000 +D 1 + 1 0.241216 1.000000 +D 1 + 1 0.575129 1.000000 +D 1 + 1 0.989127 1.000000 +F 1 + 1 0.148598 1.000000 +F 1 + 1 0.374850 1.000000 +F 1 + 1 0.781006 1.000000 +G 1 + 1 0.259548 1.000000 +G 1 + 1 0.561381 1.000000 +H 1 + 1 0.328731 1.000000 +S 1 + 1 0.0177000 1.0000000 +P 1 + 1 0.0115000 1.0000000 +D 1 + 1 0.0294000 1.0000000 +F 1 + 1 0.0509000 1.0000000 +G 1 + 1 0.1069000 1.0000000 +H 1 + 1 0.2270000 1.0000000 + +NITROGEN +S 9 + 1 0.098869 0.067266 + 2 0.211443 0.334290 + 3 0.452197 0.454257 + 4 0.967080 0.267861 + 5 2.068221 0.000248 + 6 4.423150 -0.132606 + 7 9.459462 0.014437 + 8 20.230246 0.000359 + 9 43.264919 -0.000094 +S 1 + 1 0.115320 1.000000 +S 1 + 1 0.286632 1.000000 +S 1 + 1 0.702011 1.000000 +S 1 + 1 1.532221 1.000000 +P 9 + 1 0.073234 0.035758 + 2 0.145867 0.153945 + 3 0.290535 0.277656 + 4 0.578683 0.297676 + 5 1.152612 0.234403 + 6 2.295756 0.140321 + 7 4.572652 0.067219 + 8 9.107739 0.031594 + 9 18.140657 0.003301 +P 1 + 1 0.120601 1.000000 +P 1 + 1 0.322697 1.000000 +P 1 + 1 0.978538 1.000000 +P 1 + 1 1.272759 1.000000 +D 1 + 1 0.305579 1.000000 +D 1 + 1 0.891436 1.000000 +D 1 + 1 1.542532 1.000000 +D 1 + 1 2.798122 1.000000 +F 1 + 1 0.587676 1.000000 +F 1 + 1 1.592967 1.000000 +F 1 + 1 2.443045 1.000000 +G 1 + 1 1.038637 1.000000 +G 1 + 1 2.842018 1.000000 +H 1 + 1 2.272542 1.000000 +S 1 + 1 0.0518000 1.0000000 +P 1 + 1 0.0369000 1.0000000 +D 1 + 1 0.0971000 1.0000000 +F 1 + 1 0.1920000 1.0000000 +G 1 + 1 0.4360000 1.0000000 +H 1 + 1 0.7880000 1.0000000 + +FLUORINE +S 9 + 1 0.172723 0.070240 + 2 0.364875 0.311088 + 3 0.770795 0.444675 + 4 1.628295 0.287011 + 5 3.439757 0.018759 + 6 7.266451 -0.128608 + 7 15.350300 0.009104 + 8 32.427348 0.000810 + 9 68.502433 -0.000133 +S 1 + 1 0.191146 1.000000 +S 1 + 1 0.459697 1.000000 +S 1 + 1 1.250265 1.000000 +S 1 + 1 2.542428 1.000000 +P 9 + 1 0.101001 0.035321 + 2 0.204414 0.136924 + 3 0.413707 0.249353 + 4 0.837289 0.286620 + 5 1.694565 0.254541 + 6 3.429580 0.169572 + 7 6.941026 0.088542 + 8 14.047737 0.039843 + 9 28.430799 0.003378 +P 1 + 1 0.170574 1.000000 +P 1 + 1 0.489019 1.000000 +P 1 + 1 1.505085 1.000000 +P 1 + 1 2.018698 1.000000 +D 1 + 1 0.517711 1.000000 +D 1 + 1 1.523306 1.000000 +D 1 + 1 3.901897 1.000000 +D 1 + 1 5.603581 1.000000 +F 1 + 1 0.981494 1.000000 +F 1 + 1 2.950321 1.000000 +F 1 + 1 4.297889 1.000000 +G 1 + 1 1.638933 1.000000 +G 1 + 1 4.619953 1.000000 +H 1 + 1 2.963127 1.000000 +S 1 + 1 0.0806000 1.0000000 +P 1 + 1 0.0550000 1.0000000 +D 1 + 1 0.1720000 1.0000000 +F 1 + 1 0.3310000 1.0000000 +G 1 + 1 0.6630000 1.0000000 +H 1 + 1 1.3260000 1.0000000 + +CHLORINE +S 9 + 1 0.119944 0.148917 + 2 0.257348 0.503616 + 3 0.552157 0.523995 + 4 1.184691 0.013612 + 5 2.541836 -0.328846 + 6 5.453681 0.056309 + 7 11.701243 -0.001301 + 8 25.105812 -0.000294 + 9 53.866226 0.000076 +S 1 + 1 0.152049 1.000000 +S 1 + 1 0.639110 1.000000 +S 1 + 1 0.801438 1.000000 +S 1 + 1 1.671380 1.000000 +P 9 + 1 0.074374 0.084925 + 2 0.155084 0.270658 + 3 0.323378 0.396022 + 4 0.674303 0.324325 + 5 1.406043 0.100661 + 6 2.931855 -0.069802 + 7 6.113450 -0.000951 + 8 12.747651 0.001501 + 9 26.581165 -0.000249 +P 1 + 1 0.103926 1.000000 +P 1 + 1 0.275582 1.000000 +P 1 + 1 0.667436 1.000000 +P 1 + 1 1.171614 1.000000 +D 1 + 1 0.237419 1.000000 +D 1 + 1 0.729517 1.000000 +D 1 + 1 0.924049 1.000000 +D 1 + 1 1.522182 1.000000 +F 1 + 1 0.335123 1.000000 +F 1 + 1 0.789116 1.000000 +F 1 + 1 1.609975 1.000000 +G 1 + 1 0.576133 1.000000 +G 1 + 1 1.402971 1.000000 +H 1 + 1 1.099609 1.000000 +S 1 + 1 0.0479000 1.0000000 +P 1 + 1 0.0348000 1.0000000 +D 1 + 1 0.1003000 1.0000000 +F 1 + 1 0.1640000 1.0000000 +G 1 + 1 0.2770000 1.0000000 +H 1 + 1 0.6070000 1.0000000 + +CARBON +S 9 + 1 0.051344 0.013991 + 2 0.102619 0.169852 + 3 0.205100 0.397529 + 4 0.409924 0.380369 + 5 0.819297 0.180113 + 6 1.637494 -0.033512 + 7 3.272791 -0.121499 + 8 6.541187 0.015176 + 9 13.073594 -0.000705 +S 1 + 1 0.098302 1.000000 +S 1 + 1 0.232034 1.000000 +S 1 + 1 0.744448 1.000000 +S 1 + 1 1.009914 1.000000 +P 9 + 1 0.029281 0.001787 + 2 0.058547 0.050426 + 3 0.117063 0.191634 + 4 0.234064 0.302667 + 5 0.468003 0.289868 + 6 0.935757 0.210979 + 7 1.871016 0.112024 + 8 3.741035 0.054425 + 9 7.480076 0.021931 +P 1 + 1 0.084047 1.000000 +P 1 + 1 0.216618 1.000000 +P 1 + 1 0.576869 1.000000 +P 1 + 1 1.006252 1.000000 +D 1 + 1 0.206619 1.000000 +D 1 + 1 0.606933 1.000000 +D 1 + 1 1.001526 1.000000 +D 1 + 1 1.504882 1.000000 +F 1 + 1 0.400573 1.000000 +F 1 + 1 1.099564 1.000000 +F 1 + 1 1.501091 1.000000 +G 1 + 1 0.797648 1.000000 +G 1 + 1 1.401343 1.000000 +H 1 + 1 1.001703 1.000000 +S 1 + 1 0.0394000 1.0000000 +P 1 + 1 0.0272000 1.0000000 +D 1 + 1 0.0701000 1.0000000 +F 1 + 1 0.1380000 1.0000000 +G 1 + 1 0.3190000 1.0000000 +H 1 + 1 0.5860000 1.0000000 + +OXYGEN +S 9 + 1 0.125346 0.055741 + 2 0.268022 0.304848 + 3 0.573098 0.453752 + 4 1.225429 0.295926 + 5 2.620277 0.019567 + 6 5.602818 -0.128627 + 7 11.980245 0.012024 + 8 25.616801 0.000407 + 9 54.775216 -0.000076 +S 1 + 1 0.160664 1.000000 +S 1 + 1 0.384526 1.000000 +S 1 + 1 0.935157 1.000000 +S 1 + 1 1.937532 1.000000 +P 9 + 1 0.083598 0.044958 + 2 0.167017 0.150175 + 3 0.333673 0.255999 + 4 0.666627 0.281879 + 5 1.331816 0.242835 + 6 2.660761 0.161134 + 7 5.315785 0.082308 + 8 10.620108 0.039899 + 9 21.217318 0.004679 +P 1 + 1 0.130580 1.000000 +P 1 + 1 0.372674 1.000000 +P 1 + 1 1.178227 1.000000 +P 1 + 1 1.589967 1.000000 +D 1 + 1 0.401152 1.000000 +D 1 + 1 1.174596 1.000000 +D 1 + 1 2.823972 1.000000 +D 1 + 1 4.292433 1.000000 +F 1 + 1 0.708666 1.000000 +F 1 + 1 2.006788 1.000000 +F 1 + 1 3.223721 1.000000 +G 1 + 1 1.207657 1.000000 +G 1 + 1 3.584495 1.000000 +H 1 + 1 2.615818 1.000000 +S 1 + 1 0.0655000 1.0000000 +P 1 + 1 0.0446000 1.0000000 +D 1 + 1 0.1310000 1.0000000 +F 1 + 1 0.2370000 1.0000000 +G 1 + 1 0.5170000 1.0000000 +H 1 + 1 1.0240000 1.0000000 + +HYDROGEN +S 9 + 1 0.013000 0.000706 + 2 0.029900 -0.002119 + 3 0.068770 0.057693 + 4 0.158170 0.230695 + 5 0.363792 0.277612 + 6 0.836721 0.169833 + 7 1.924458 0.097443 + 8 4.426254 0.029966 + 9 10.180385 -0.000452 +S 1 + 1 0.122344 1.000000 +S 1 + 1 0.402892 1.000000 +S 1 + 1 0.715047 1.000000 +S 1 + 1 1.379838 1.000000 +P 9 + 1 0.003000 0.001242 + 2 0.007800 -0.000913 + 3 0.020281 -0.000054 + 4 0.052730 -0.000238 + 5 0.137097 -0.011530 + 6 0.356451 -0.018235 + 7 0.926774 -0.013929 + 8 2.409612 -0.009395 + 9 6.264991 -0.000347 +P 1 + 1 0.784765 1.000000 +P 1 + 1 0.173606 1.000000 +P 1 + 1 0.513665 1.000000 +D 1 + 1 2.917388 1.000000 +D 1 + 1 0.466379 1.000000 +D 1 + 1 1.132171 1.000000 +F 1 + 1 1.649608 1.000000 +F 1 + 1 0.793185 1.000000 +G 1 + 1 1.606813 1.000000 +S 1 + 1 0.0207000 1.0000000 +P 1 + 1 0.0744000 1.0000000 +D 1 + 1 0.1560000 1.0000000 +F 1 + 1 0.2740000 1.0000000 +G 1 + 1 0.5430000 1.0000000 + +PHOSPHORUS +S 9 + 1 0.074718 0.140225 + 2 0.160834 0.506746 + 3 0.346202 0.499893 + 4 0.745215 0.037301 + 5 1.604109 -0.284591 + 6 3.452917 0.024766 + 7 7.432561 0.001798 + 8 15.998924 -0.000314 + 9 34.438408 0.000088 +S 1 + 1 0.082092 1.000000 +S 1 + 1 0.195525 1.000000 +S 1 + 1 0.434767 1.000000 +S 1 + 1 1.027573 1.000000 +P 9 + 1 0.050242 0.072095 + 2 0.102391 0.278735 + 3 0.208669 0.411034 + 4 0.425256 0.304724 + 5 0.866651 0.091727 + 6 1.766191 -0.057060 + 7 3.599410 -0.005103 + 8 7.335418 0.000328 + 9 14.949217 -0.000046 +P 1 + 1 0.074159 1.000000 +P 1 + 1 0.189382 1.000000 +P 1 + 1 0.470798 1.000000 +P 1 + 1 0.815677 1.000000 +D 1 + 1 0.167800 1.000000 +D 1 + 1 0.457307 1.000000 +D 1 + 1 1.021650 1.000000 +D 1 + 1 1.598720 1.000000 +F 1 + 1 0.214751 1.000000 +F 1 + 1 0.482380 1.000000 +F 1 + 1 0.984966 1.000000 +G 1 + 1 0.406484 1.000000 +G 1 + 1 0.924507 1.000000 +H 1 + 1 0.831913 1.000000 +S 1 + 1 0.0335000 1.0000000 +P 1 + 1 0.0253000 1.0000000 +D 1 + 1 0.0624000 1.0000000 +F 1 + 1 0.0950000 1.0000000 +G 1 + 1 0.1840000 1.0000000 +H 1 + 1 0.3720000 1.0000000 + +SILICON +S 9 + 1 0.059887 0.167492 + 2 0.130108 0.532550 + 3 0.282668 0.464290 + 4 0.614115 -0.002322 + 5 1.334205 -0.268234 + 6 2.898645 0.031921 + 7 6.297493 -0.000106 + 8 13.681707 -0.000145 + 9 29.724387 0.000067 +S 1 + 1 0.075500 1.000000 +S 1 + 1 0.196459 1.000000 +S 1 + 1 0.424036 1.000000 +S 1 + 1 0.920486 1.000000 +P 9 + 1 0.036525 0.078761 + 2 0.076137 0.308331 + 3 0.158712 0.417773 + 4 0.330843 0.281676 + 5 0.689658 0.069876 + 6 1.437625 -0.056306 + 7 2.996797 0.000744 + 8 6.246966 -0.000259 + 9 13.022097 -0.000022 +P 1 + 1 0.048136 1.000000 +P 1 + 1 0.115813 1.000000 +P 1 + 1 0.238594 1.000000 +P 1 + 1 0.496918 1.000000 +D 1 + 1 0.127945 1.000000 +D 1 + 1 0.353096 1.000000 +D 1 + 1 0.805426 1.000000 +D 1 + 1 1.247695 1.000000 +F 1 + 1 0.172876 1.000000 +F 1 + 1 0.402208 1.000000 +F 1 + 1 0.833081 1.000000 +G 1 + 1 0.299885 1.000000 +G 1 + 1 0.647054 1.000000 +H 1 + 1 0.557542 1.000000 +S 1 + 1 0.0260000 1.0000000 +P 1 + 1 0.0192000 1.0000000 +D 1 + 1 0.0468000 1.0000000 +F 1 + 1 0.0735000 1.0000000 +G 1 + 1 0.1510000 1.0000000 +H 1 + 1 0.3230000 1.0000000 + +ARGON +S 9 + 1 0.147347 0.155473 + 2 0.312164 0.494617 + 3 0.661339 0.526705 + 4 1.401090 0.021986 + 5 2.968301 -0.338533 + 6 6.288539 0.056023 + 7 13.322677 -0.000115 + 8 28.224956 -0.000595 + 9 59.796402 0.000127 +S 1 + 1 0.189594 1.000000 +S 1 + 1 0.778040 1.000000 +S 1 + 1 0.971266 1.000000 +S 1 + 1 1.979612 1.000000 +P 9 + 1 0.090580 0.079101 + 2 0.188085 0.260718 + 3 0.390548 0.395065 + 4 0.810953 0.334954 + 5 1.683902 0.107462 + 6 3.496535 -0.073657 + 7 7.260371 -0.001407 + 8 15.075781 0.001710 + 9 31.304069 -0.000275 +P 1 + 1 0.133916 1.000000 +P 1 + 1 0.356186 1.000000 +P 1 + 1 0.833562 1.000000 +P 1 + 1 1.430927 1.000000 +D 1 + 1 0.268113 1.000000 +D 1 + 1 0.697753 1.000000 +D 1 + 1 1.185366 1.000000 +D 1 + 1 2.118102 1.000000 +F 1 + 1 0.422461 1.000000 +F 1 + 1 0.973776 1.000000 +F 1 + 1 2.020616 1.000000 +G 1 + 1 0.695217 1.000000 +G 1 + 1 1.690111 1.000000 +H 1 + 1 1.258944 1.000000 +S 1 + 1 0.0538000 1.0000000 +P 1 + 1 0.0402000 1.0000000 +D 1 + 1 0.1210000 1.0000000 +F 1 + 1 0.2090000 1.0000000 +G 1 + 1 0.3340000 1.0000000 +H 1 + 1 0.7420000 1.0000000 + +SULFUR +S 9 + 1 0.095120 0.140074 + 2 0.202385 0.490942 + 3 0.430611 0.515297 + 4 0.916203 0.050320 + 5 1.949388 -0.298908 + 6 4.147674 0.019827 + 7 8.824926 0.007266 + 8 18.776623 -0.001602 + 9 39.950656 0.000271 +S 1 + 1 0.113918 1.000000 +S 1 + 1 0.282790 1.000000 +S 1 + 1 0.626702 1.000000 +S 1 + 1 1.338226 1.000000 +P 9 + 1 0.057087 0.081938 + 2 0.115901 0.251826 + 3 0.235305 0.376344 + 4 0.477723 0.320902 + 5 0.969889 0.143779 + 6 1.969099 -0.045543 + 7 3.997726 -0.017191 + 8 8.116307 0.002580 + 9 16.477979 -0.000222 +P 1 + 1 0.079101 1.000000 +P 1 + 1 0.210632 1.000000 +P 1 + 1 0.522537 1.000000 +P 1 + 1 0.924454 1.000000 +D 1 + 1 0.186546 1.000000 +D 1 + 1 0.462328 1.000000 +D 1 + 1 0.955579 1.000000 +D 1 + 1 2.334308 1.000000 +F 1 + 1 0.274343 1.000000 +F 1 + 1 0.661568 1.000000 +F 1 + 1 1.389533 1.000000 +G 1 + 1 0.486698 1.000000 +G 1 + 1 1.166495 1.000000 +H 1 + 1 0.839494 1.000000 +S 1 + 1 0.0420000 1.0000000 +P 1 + 1 0.0294000 1.0000000 +D 1 + 1 0.0794000 1.0000000 +F 1 + 1 0.1188000 1.0000000 +G 1 + 1 0.2200000 1.0000000 +H 1 + 1 0.4720000 1.0000000 + +HELIUM +S 9 + 1 0.077786 0.012425 + 2 0.161528 0.128251 + 3 0.335425 0.282221 + 4 0.696535 0.292427 + 5 1.446408 0.215025 + 6 3.003576 0.125450 + 7 6.237154 0.064912 + 8 12.951926 0.038892 + 9 26.895662 0.002531 +S 1 + 1 1.324312 1.000000 +S 1 + 1 0.876976 1.000000 +S 1 + 1 0.294075 1.000000 +S 1 + 1 0.116506 1.000000 +P 8 + 1 0.228528 -0.000116 + 2 0.422019 2.116950 + 3 0.779333 -2.182954 + 4 1.439180 1.545850 + 5 2.657706 -0.879477 + 6 4.907934 0.469710 + 7 9.063386 -0.224631 + 8 16.737180 0.098422 +P 1 + 1 6.741009 1.000000 +P 1 + 1 2.647340 1.000000 +P 1 + 1 0.893850 1.000000 +D 1 + 1 1.842278 1.000000 +D 1 + 1 2.175208 1.000000 +D 1 + 1 4.285515 1.000000 +F 1 + 1 0.749734 1.000000 +F 1 + 1 1.632074 1.000000 +G 1 + 1 0.623669 1.000000 +S 1 + 1 0.0466400 1.0000000 +P 1 + 1 0.1400000 1.0000000 +D 1 + 1 0.2892000 1.0000000 +F 1 + 1 0.5345000 1.0000000 +G 1 + 1 0.7899000 1.0000000 + + diff --git a/data/basis/avdz-bfd b/data/basis/avdz-bfd new file mode 100644 index 00000000..a85c3d3d --- /dev/null +++ b/data/basis/avdz-bfd @@ -0,0 +1,804 @@ +ARSENIC +S 9 + 1 0.079412 0.192043 + 2 0.178687 0.611682 + 3 0.402068 0.439261 + 4 0.904702 -0.110280 + 5 2.035691 -0.394179 + 6 4.580555 0.145632 + 7 10.306811 -0.021379 + 8 23.191593 0.003205 + 9 52.183937 -0.000469 +S 1 + 1 0.051480 1.000000 +P 9 + 1 0.050626 0.105058 + 2 0.108692 0.361819 + 3 0.233354 0.452107 + 4 0.500995 0.231243 + 5 1.075603 -0.009549 + 6 2.309248 -0.121767 + 7 4.957802 0.028648 + 8 10.644071 -0.002941 + 9 22.852115 0.000293 +P 1 + 1 0.095623 1.000000 +D 1 + 1 0.297652 1.000000 +S 1 + 1 0.0411520 1.0000000 +P 1 + 1 0.0312680 1.0000000 +D 1 + 1 0.1078000 1.0000000 + +LITHIUM +S 9 + 1 0.010125 0.007841 + 2 0.023437 0.258118 + 3 0.054251 0.423307 + 4 0.125581 0.167825 + 5 0.290697 -0.068332 + 6 0.672909 -0.119269 + 7 1.557659 0.007736 + 8 3.605689 0.003630 + 9 8.346494 -0.000646 +S 1 + 1 0.103721 1.000000 +P 9 + 1 0.018300 -0.005906 + 2 0.031699 -0.031422 + 3 0.054908 -0.043628 + 4 0.095111 -0.016781 + 5 0.164751 -0.078594 + 6 0.285379 0.015562 + 7 0.494330 -0.030830 + 8 0.856273 0.006185 + 9 1.483225 -0.008621 +P 1 + 1 0.070391 1.000000 +D 1 + 1 0.110720 1.000000 +S 1 + 1 0.0086400 1.0000000 +P 1 + 1 0.0057900 1.0000000 +D 1 + 1 0.0725000 1.0000000 + +GERMANIUM +S 9 + 1 0.066287 0.213230 + 2 0.150128 0.605570 + 3 0.340013 0.413442 + 4 0.770064 -0.106356 + 5 1.744049 -0.364579 + 6 3.949940 0.127448 + 7 8.945864 -0.017166 + 8 20.260687 0.002454 + 9 45.886614 -0.000355 +S 1 + 1 0.043781 1.000000 +P 9 + 1 0.036511 0.098680 + 2 0.080524 0.372290 + 3 0.177593 0.443836 + 4 0.391677 0.232585 + 5 0.863832 0.000058 + 6 1.905157 -0.108282 + 7 4.201772 0.021894 + 8 9.266892 -0.001911 + 9 20.437873 0.000181 +P 1 + 1 0.074726 1.000000 +D 1 + 1 0.234278 1.000000 +S 1 + 1 0.0339610 1.0000000 +P 1 + 1 0.0239450 1.0000000 +D 1 + 1 0.0771000 1.0000000 + +NEON +S 9 + 1 0.205835 0.057514 + 2 0.391384 0.215776 + 3 0.744196 0.374799 + 4 1.415048 0.326313 + 5 2.690638 0.166383 + 6 5.116103 -0.039149 + 7 9.727994 -0.085909 + 8 18.497256 0.006816 + 9 35.171534 0.000206 +S 1 + 1 0.455383 1.000000 +P 9 + 1 0.121772 0.029943 + 2 0.238248 0.114200 + 3 0.466136 0.219618 + 4 0.912002 0.268864 + 5 1.784344 0.256932 + 6 3.491095 0.191378 + 7 6.830378 0.112176 + 8 13.363732 0.063317 + 9 26.146332 0.008057 +P 1 + 1 0.472224 1.000000 +D 1 + 1 2.371533 1.000000 +S 1 + 1 0.1230000 1.0000000 +P 1 + 1 0.1064000 1.0000000 +D 1 + 1 0.6310000 1.0000000 + +BORON +S 9 + 1 0.040569 0.032031 + 2 0.081044 0.243317 + 3 0.161898 0.434636 + 4 0.323418 0.329581 + 5 0.646080 0.111875 + 6 1.290648 -0.078699 + 7 2.578276 -0.098781 + 8 5.150520 0.016164 + 9 10.288990 -0.000016 +S 1 + 1 0.082513 1.000000 +P 9 + 1 0.029207 0.019909 + 2 0.058408 0.141775 + 3 0.116803 0.294463 + 4 0.233582 0.309028 + 5 0.467115 0.236378 + 6 0.934132 0.131317 + 7 1.868068 0.066454 + 8 3.735743 0.021248 + 9 7.470701 0.002837 +P 1 + 1 0.086803 1.000000 +D 1 + 1 0.349879 1.000000 +S 1 + 1 0.0310500 1.0000000 +P 1 + 1 0.0237800 1.0000000 +D 1 + 1 0.0904000 1.0000000 + +GALLIUM +S 9 + 1 0.054628 0.253171 + 2 0.123743 0.598295 + 3 0.280299 0.356909 + 4 0.634926 -0.056544 + 5 1.438218 -0.411266 + 6 3.257814 0.156079 + 7 7.379514 -0.025142 + 8 16.715879 0.004089 + 9 37.864367 -0.000622 +S 1 + 1 0.031898 1.000000 +P 9 + 1 0.029207 0.759400 + 2 0.064420 -0.022059 + 3 0.142086 0.368252 + 4 0.313389 0.051142 + 5 0.691221 0.036655 + 6 1.524577 -0.078589 + 7 3.362652 0.017781 + 8 7.416764 -0.002498 + 9 16.358632 0.000386 +P 1 + 1 0.027155 1.000000 +D 1 + 1 0.182311 1.000000 +S 1 + 1 0.0243480 1.0000000 +P 1 + 1 0.0151640 1.0000000 +D 1 + 1 0.0537000 1.0000000 + +ALUMINUM +S 9 + 1 0.045518 0.206193 + 2 0.100308 0.559887 + 3 0.221051 0.407852 + 4 0.487132 -0.041098 + 5 1.073500 -0.238652 + 6 2.365686 0.038132 + 7 5.213294 -0.003935 + 8 11.488606 0.000470 + 9 25.317597 -0.000014 +S 1 + 1 0.044024 1.000000 +P 9 + 1 0.014848 0.009932 + 2 0.030967 0.160212 + 3 0.064586 0.389171 + 4 0.134700 0.373235 + 5 0.280932 0.195800 + 6 0.585913 0.022947 + 7 1.221985 -0.053293 + 8 2.548578 0.004846 + 9 5.315330 -0.000726 +P 1 + 1 0.206631 1.000000 +D 1 + 1 0.193079 1.000000 +S 1 + 1 0.0231000 1.0000000 +P 1 + 1 0.0153000 1.0000000 +D 1 + 1 0.0535000 1.0000000 + +MAGNESIUM +S 9 + 1 0.030975 0.165290 + 2 0.062959 0.506272 + 3 0.127970 0.333197 + 4 0.260111 0.057482 + 5 0.528700 -0.137614 + 6 1.074630 -0.135378 + 7 2.184285 0.048310 + 8 4.439759 -0.005312 + 9 9.024217 0.000465 +S 1 + 1 0.162370 1.000000 +P 9 + 1 0.047055 1.502038 + 2 0.083253 -1.433944 + 3 0.147298 1.318987 + 4 0.260611 -0.741124 + 5 0.461094 0.436300 + 6 0.815803 -0.243798 + 7 1.443383 0.086774 + 8 2.553745 -0.028677 + 9 4.518286 0.006085 +P 1 + 1 0.121683 1.000000 +D 1 + 1 0.135526 1.000000 +S 1 + 1 0.0148800 1.0000000 +P 1 + 1 0.0093500 1.0000000 +D 1 + 1 0.0595000 1.0000000 + +NITROGEN +S 9 + 1 0.098869 0.067266 + 2 0.211443 0.334290 + 3 0.452197 0.454257 + 4 0.967080 0.267861 + 5 2.068221 0.000248 + 6 4.423150 -0.132606 + 7 9.459462 0.014437 + 8 20.230246 0.000359 + 9 43.264919 -0.000094 +S 1 + 1 0.175123 1.000000 +P 9 + 1 0.073234 0.035758 + 2 0.145867 0.153945 + 3 0.290535 0.277656 + 4 0.578683 0.297676 + 5 1.152612 0.234403 + 6 2.295756 0.140321 + 7 4.572652 0.067219 + 8 9.107739 0.031594 + 9 18.140657 0.003301 +P 1 + 1 0.223042 1.000000 +D 1 + 1 0.832058 1.000000 +S 1 + 1 0.0612400 1.0000000 +P 1 + 1 0.0561100 1.0000000 +D 1 + 1 0.2300000 1.0000000 + +BROMINE +S 9 + 1 0.114626 0.199832 + 2 0.253024 0.605806 + 3 0.558520 0.486414 + 4 1.232866 -0.208964 + 5 2.721403 -0.328448 + 6 6.007171 0.118471 + 7 13.260109 -0.013112 + 8 29.270100 0.001206 + 9 64.610234 -0.000121 +S 1 + 1 0.074712 1.000000 +P 9 + 1 0.067990 0.107992 + 2 0.145507 0.331860 + 3 0.311403 0.442871 + 4 0.666441 0.283256 + 5 1.426267 -0.026045 + 6 3.052389 -0.111323 + 7 6.532494 0.021712 + 8 13.980353 -0.001188 + 9 29.919703 0.000022 +P 1 + 1 0.129654 1.000000 +D 1 + 1 0.417296 1.000000 +S 1 + 1 0.0569460 1.0000000 +P 1 + 1 0.0410490 1.0000000 +D 1 + 1 0.1719000 1.0000000 + +FLUORINE +S 9 + 1 0.172723 0.070240 + 2 0.364875 0.311088 + 3 0.770795 0.444675 + 4 1.628295 0.287011 + 5 3.439757 0.018759 + 6 7.266451 -0.128608 + 7 15.350300 0.009104 + 8 32.427348 0.000810 + 9 68.502433 -0.000133 +S 1 + 1 0.344569 1.000000 +P 9 + 1 0.101001 0.035321 + 2 0.204414 0.136924 + 3 0.413707 0.249353 + 4 0.837289 0.286620 + 5 1.694565 0.254541 + 6 3.429580 0.169572 + 7 6.941026 0.088542 + 8 14.047737 0.039843 + 9 28.430799 0.003378 +P 1 + 1 0.364831 1.000000 +D 1 + 1 1.722479 1.000000 +S 1 + 1 0.0986300 1.0000000 +P 1 + 1 0.0850200 1.0000000 +D 1 + 1 0.4640000 1.0000000 + +CHLORINE +S 9 + 1 0.119944 0.148917 + 2 0.257348 0.503616 + 3 0.552157 0.523995 + 4 1.184691 0.013612 + 5 2.541836 -0.328846 + 6 5.453681 0.056309 + 7 11.701243 -0.001301 + 8 25.105812 -0.000294 + 9 53.866226 0.000076 +S 1 + 1 0.120667 1.000000 +P 9 + 1 0.074374 0.084925 + 2 0.155084 0.270658 + 3 0.323378 0.396022 + 4 0.674303 0.324325 + 5 1.406043 0.100661 + 6 2.931855 -0.069802 + 7 6.113450 -0.000951 + 8 12.747651 0.001501 + 9 26.581165 -0.000249 +P 1 + 1 0.168333 1.000000 +D 1 + 1 0.651071 1.000000 +S 1 + 1 0.0608000 1.0000000 +P 1 + 1 0.0466000 1.0000000 +D 1 + 1 0.1960000 1.0000000 + +CARBON +S 9 + 1 0.051344 0.013991 + 2 0.102619 0.169852 + 3 0.205100 0.397529 + 4 0.409924 0.380369 + 5 0.819297 0.180113 + 6 1.637494 -0.033512 + 7 3.272791 -0.121499 + 8 6.541187 0.015176 + 9 13.073594 -0.000705 +S 1 + 1 0.127852 1.000000 +P 9 + 1 0.029281 0.001787 + 2 0.058547 0.050426 + 3 0.117063 0.191634 + 4 0.234064 0.302667 + 5 0.468003 0.289868 + 6 0.935757 0.210979 + 7 1.871016 0.112024 + 8 3.741035 0.054425 + 9 7.480076 0.021931 +P 1 + 1 0.149161 1.000000 +D 1 + 1 0.561160 1.000000 +S 1 + 1 0.0469000 1.0000000 +P 1 + 1 0.0404100 1.0000000 +D 1 + 1 0.1510000 1.0000000 + +OXYGEN +S 9 + 1 0.125346 0.055741 + 2 0.268022 0.304848 + 3 0.573098 0.453752 + 4 1.225429 0.295926 + 5 2.620277 0.019567 + 6 5.602818 -0.128627 + 7 11.980245 0.012024 + 8 25.616801 0.000407 + 9 54.775216 -0.000076 +S 1 + 1 0.258551 1.000000 +P 9 + 1 0.083598 0.044958 + 2 0.167017 0.150175 + 3 0.333673 0.255999 + 4 0.666627 0.281879 + 5 1.331816 0.242835 + 6 2.660761 0.161134 + 7 5.315785 0.082308 + 8 10.620108 0.039899 + 9 21.217318 0.004679 +P 1 + 1 0.267865 1.000000 +D 1 + 1 1.232753 1.000000 +S 1 + 1 0.0789600 1.0000000 +P 1 + 1 0.0685600 1.0000000 +D 1 + 1 0.3320000 1.0000000 + +KRYPTON +S 9 + 1 0.129911 0.183453 + 2 0.282220 0.596016 + 3 0.613098 0.506410 + 4 1.331901 -0.150926 + 5 2.893437 -0.423611 + 6 6.285735 0.162644 + 7 13.655203 -0.023284 + 8 29.664719 0.003157 + 9 64.443973 -0.000422 +S 1 + 1 0.634619 1.000000 +P 9 + 1 0.079314 0.096705 + 2 0.167216 0.312567 + 3 0.352539 0.448237 + 4 0.743252 0.298640 + 5 1.566988 -0.003641 + 6 3.303659 -0.138798 + 7 6.965055 0.029989 + 8 14.684325 -0.002578 + 9 30.958748 0.000205 +P 1 + 1 0.149902 1.000000 +D 1 + 1 0.487932 1.000000 +S 1 + 1 0.0651450 1.0000000 +P 1 + 1 0.0466060 1.0000000 +D 1 + 1 0.2155000 1.0000000 + +HYDROGEN +S 9 + 1 0.013000 0.000706 + 2 0.029900 -0.002119 + 3 0.068770 0.057693 + 4 0.158170 0.230695 + 5 0.363792 0.277612 + 6 0.836721 0.169833 + 7 1.924458 0.097443 + 8 4.426254 0.029966 + 9 10.180385 -0.000452 +S 1 + 1 0.170483 1.000000 +P 9 + 1 0.003000 0.001242 + 2 0.007800 -0.000913 + 3 0.020281 -0.000054 + 4 0.052730 -0.000238 + 5 0.137097 -0.011530 + 6 0.356451 -0.018235 + 7 0.926774 -0.013929 + 8 2.409612 -0.009395 + 9 6.264991 -0.000347 +S 1 + 1 0.0297400 1.0000000 +P 1 + 1 0.1410000 1.0000000 + +PHOSPHORUS +S 9 + 1 0.074718 0.140225 + 2 0.160834 0.506746 + 3 0.346202 0.499893 + 4 0.745215 0.037301 + 5 1.604109 -0.284591 + 6 3.452917 0.024766 + 7 7.432561 0.001798 + 8 15.998924 -0.000314 + 9 34.438408 0.000088 +S 1 + 1 0.077260 1.000000 +P 9 + 1 0.050242 0.072095 + 2 0.102391 0.278735 + 3 0.208669 0.411034 + 4 0.425256 0.304724 + 5 0.866651 0.091727 + 6 1.766191 -0.057060 + 7 3.599410 -0.005103 + 8 7.335418 0.000328 + 9 14.949217 -0.000046 +P 1 + 1 0.113433 1.000000 +D 1 + 1 0.390944 1.000000 +S 1 + 1 0.0417000 1.0000000 +P 1 + 1 0.0343000 1.0000000 +D 1 + 1 0.1130000 1.0000000 + +SILICON +S 9 + 1 0.059887 0.167492 + 2 0.130108 0.532550 + 3 0.282668 0.464290 + 4 0.614115 -0.002322 + 5 1.334205 -0.268234 + 6 2.898645 0.031921 + 7 6.297493 -0.000106 + 8 13.681707 -0.000145 + 9 29.724387 0.000067 +S 1 + 1 0.059803 1.000000 +P 9 + 1 0.036525 0.078761 + 2 0.076137 0.308331 + 3 0.158712 0.417773 + 4 0.330843 0.281676 + 5 0.689658 0.069876 + 6 1.437625 -0.056306 + 7 2.996797 0.000744 + 8 6.246966 -0.000259 + 9 13.022097 -0.000022 +P 1 + 1 0.081570 1.000000 +D 1 + 1 0.283626 1.000000 +S 1 + 1 0.0332000 1.0000000 +P 1 + 1 0.0250000 1.0000000 +D 1 + 1 0.0823000 1.0000000 + +ARGON +S 9 + 1 0.147347 0.155473 + 2 0.312164 0.494617 + 3 0.661339 0.526705 + 4 1.401090 0.021986 + 5 2.968301 -0.338533 + 6 6.288539 0.056023 + 7 13.322677 -0.000115 + 8 28.224956 -0.000595 + 9 59.796402 0.000127 +S 1 + 1 0.147526 1.000000 +P 9 + 1 0.090580 0.079101 + 2 0.188085 0.260718 + 3 0.390548 0.395065 + 4 0.810953 0.334954 + 5 1.683902 0.107462 + 6 3.496535 -0.073657 + 7 7.260371 -0.001407 + 8 15.075781 0.001710 + 9 31.304069 -0.000275 +P 1 + 1 0.211798 1.000000 +D 1 + 1 0.810888 1.000000 +S 1 + 1 0.0709000 1.0000000 +P 1 + 1 0.0533000 1.0000000 +D 1 + 1 0.2400000 1.0000000 + +SODIUM +S 9 + 1 0.013061 0.200118 + 2 0.030041 0.467652 + 3 0.069092 0.227738 + 4 0.158908 -0.061581 + 5 0.365481 -0.137533 + 6 0.840589 0.003323 + 7 1.933315 0.003741 + 8 4.446533 -0.001117 + 9 10.226816 0.000244 +S 1 + 1 0.865135 1.000000 +P 9 + 1 0.002593 -0.002840 + 2 0.006741 0.005340 + 3 0.017525 -0.025936 + 4 0.045563 -0.053466 + 5 0.118461 -0.053691 + 6 0.307987 0.014439 + 7 0.800738 0.006199 + 8 2.081847 -0.001026 + 9 5.412617 0.000168 +P 1 + 1 0.106025 1.000000 +D 1 + 1 0.050790 1.000000 +S 1 + 1 0.0072500 1.0000000 +P 1 + 1 0.0063300 1.0000000 +D 1 + 1 0.0468000 1.0000000 + +BERYLLIUM +S 9 + 1 0.030068 0.025105 + 2 0.054002 0.178890 + 3 0.096986 0.263939 + 4 0.174186 0.435946 + 5 0.312836 -0.008188 + 6 0.561850 0.049509 + 7 1.009077 -0.114576 + 8 1.812290 -0.067207 + 9 3.254852 0.017250 +S 1 + 1 0.239392 1.000000 +P 9 + 1 0.015064 0.735052 + 2 0.028584 -0.476214 + 3 0.054236 0.564806 + 4 0.102911 -0.108575 + 5 0.195269 0.233862 + 6 0.370513 -0.009003 + 7 0.703030 0.067510 + 8 1.333967 -0.002868 + 9 2.531139 0.017869 +P 1 + 1 0.222969 1.000000 +D 1 + 1 0.217340 1.000000 +S 1 + 1 0.0187700 1.0000000 +P 1 + 1 0.0085000 1.0000000 +D 1 + 1 0.0740000 1.0000000 + +SELENIUM +S 9 + 1 0.096883 0.200965 + 2 0.217674 0.615093 + 3 0.489067 0.462636 + 4 1.098828 -0.204179 + 5 2.468828 -0.307584 + 6 5.546920 0.109895 + 7 12.462726 -0.012288 + 8 28.001040 0.001205 + 9 62.912258 -0.000132 +S 1 + 1 0.062467 1.000000 +P 9 + 1 0.056147 0.073504 + 2 0.122259 0.334692 + 3 0.266220 0.473323 + 4 0.579694 0.276571 + 5 1.262286 -0.032356 + 6 2.748631 -0.103709 + 7 5.985152 0.020181 + 8 13.032685 -0.001095 + 9 28.378708 0.000019 +P 1 + 1 0.107381 1.000000 +D 1 + 1 0.348649 1.000000 +S 1 + 1 0.0487470 1.0000000 +P 1 + 1 0.0354920 1.0000000 +D 1 + 1 0.1283000 1.0000000 + +SULFUR +S 9 + 1 0.095120 0.140074 + 2 0.202385 0.490942 + 3 0.430611 0.515297 + 4 0.916203 0.050320 + 5 1.949388 -0.298908 + 6 4.147674 0.019827 + 7 8.824926 0.007266 + 8 18.776623 -0.001602 + 9 39.950656 0.000271 +S 1 + 1 0.098454 1.000000 +P 9 + 1 0.057087 0.081938 + 2 0.115901 0.251826 + 3 0.235305 0.376344 + 4 0.477723 0.320902 + 5 0.969889 0.143779 + 6 1.969099 -0.045543 + 7 3.997726 -0.017191 + 8 8.116307 0.002580 + 9 16.477979 -0.000222 +P 1 + 1 0.128926 1.000000 +D 1 + 1 0.514135 1.000000 +S 1 + 1 0.0507000 1.0000000 +P 1 + 1 0.0399000 1.0000000 +D 1 + 1 0.1520000 1.0000000 + +HELIUM +S 9 + 1 0.077786 0.012425 + 2 0.161528 0.128251 + 3 0.335425 0.282221 + 4 0.696535 0.292427 + 5 1.446408 0.215025 + 6 3.003576 0.125450 + 7 6.237154 0.064912 + 8 12.951926 0.038892 + 9 26.895662 0.002531 +S 1 + 1 0.321750 1.000000 +P 8 + 1 0.228528 -0.000116 + 2 0.422019 2.116950 + 3 0.779333 -2.182954 + 4 1.439180 1.545850 + 5 2.657706 -0.879477 + 6 4.907934 0.469710 + 7 9.063386 -0.224631 + 8 16.737180 0.098422 +S 1 + 1 0.0725500 1.0000000 +P 1 + 1 0.2473000 1.0000000 + + diff --git a/data/basis/avqz-bfd b/data/basis/avqz-bfd new file mode 100644 index 00000000..7a3b35d2 --- /dev/null +++ b/data/basis/avqz-bfd @@ -0,0 +1,988 @@ +LITHIUM +S 9 + 1 0.010125 0.007841 + 2 0.023437 0.258118 + 3 0.054251 0.423307 + 4 0.125581 0.167825 + 5 0.290697 -0.068332 + 6 0.672909 -0.119269 + 7 1.557659 0.007736 + 8 3.605689 0.003630 + 9 8.346494 -0.000646 +S 1 + 1 0.024834 1.000000 +S 1 + 1 0.109770 1.000000 +S 1 + 1 0.519693 1.000000 +P 9 + 1 0.018300 -0.005906 + 2 0.031699 -0.031422 + 3 0.054908 -0.043628 + 4 0.095111 -0.016781 + 5 0.164751 -0.078594 + 6 0.285379 0.015562 + 7 0.494330 -0.030830 + 8 0.856273 0.006185 + 9 1.483225 -0.008621 +P 1 + 1 0.070662 1.000000 +P 1 + 1 0.115823 1.000000 +P 1 + 1 0.207505 1.000000 +D 1 + 1 0.029817 1.000000 +D 1 + 1 0.089353 1.000000 +D 1 + 1 0.214990 1.000000 +F 1 + 1 0.099930 1.000000 +F 1 + 1 0.240323 1.000000 +G 1 + 1 0.199570 1.000000 +S 1 + 1 0.0063600 1.0000000 +P 1 + 1 0.0075600 1.0000000 +D 1 + 1 0.0266000 1.0000000 +F 1 + 1 0.0552000 1.0000000 +G 1 + 1 0.1050000 1.0000000 + +NEON +S 9 + 1 0.205835 0.057514 + 2 0.391384 0.215776 + 3 0.744196 0.374799 + 4 1.415048 0.326313 + 5 2.690638 0.166383 + 6 5.116103 -0.039149 + 7 9.727994 -0.085909 + 8 18.497256 0.006816 + 9 35.171534 0.000206 +S 1 + 1 0.399186 1.000000 +S 1 + 1 1.658402 1.000000 +S 1 + 1 2.261159 1.000000 +P 9 + 1 0.121772 0.029943 + 2 0.238248 0.114200 + 3 0.466136 0.219618 + 4 0.912002 0.268864 + 5 1.784344 0.256932 + 6 3.491095 0.191378 + 7 6.830378 0.112176 + 8 13.363732 0.063317 + 9 26.146332 0.008057 +P 1 + 1 0.245215 1.000000 +P 1 + 1 0.757342 1.000000 +P 1 + 1 1.938376 1.000000 +D 1 + 1 0.738131 1.000000 +D 1 + 1 2.188751 1.000000 +D 1 + 1 6.170224 1.000000 +F 1 + 1 1.589986 1.000000 +F 1 + 1 4.849402 1.000000 +G 1 + 1 3.228793 1.000000 +S 1 + 1 0.1054000 1.0000000 +P 1 + 1 0.0817800 1.0000000 +D 1 + 1 0.2730000 1.0000000 +F 1 + 1 0.6890000 1.0000000 +G 1 + 1 1.2240000 1.0000000 + +BORON +S 9 + 1 0.040569 0.032031 + 2 0.081044 0.243317 + 3 0.161898 0.434636 + 4 0.323418 0.329581 + 5 0.646080 0.111875 + 6 1.290648 -0.078699 + 7 2.578276 -0.098781 + 8 5.150520 0.016164 + 9 10.288990 -0.000016 +S 1 + 1 0.082968 1.000000 +S 1 + 1 0.305133 1.000000 +S 1 + 1 0.422217 1.000000 +P 9 + 1 0.029207 0.019909 + 2 0.058408 0.141775 + 3 0.116803 0.294463 + 4 0.233582 0.309028 + 5 0.467115 0.236378 + 6 0.934132 0.131317 + 7 1.868068 0.066454 + 8 3.735743 0.021248 + 9 7.470701 0.002837 +P 1 + 1 0.066445 1.000000 +P 1 + 1 0.196614 1.000000 +P 1 + 1 0.447031 1.000000 +D 1 + 1 0.149100 1.000000 +D 1 + 1 0.410733 1.000000 +D 1 + 1 1.142614 1.000000 +F 1 + 1 0.315902 1.000000 +F 1 + 1 0.870011 1.000000 +G 1 + 1 0.710746 1.000000 +S 1 + 1 0.0272100 1.0000000 +P 1 + 1 0.0187800 1.0000000 +D 1 + 1 0.0466000 1.0000000 +F 1 + 1 0.1130000 1.0000000 +G 1 + 1 0.2730000 1.0000000 + +ALUMINUM +S 9 + 1 0.045518 0.206193 + 2 0.100308 0.559887 + 3 0.221051 0.407852 + 4 0.487132 -0.041098 + 5 1.073500 -0.238652 + 6 2.365686 0.038132 + 7 5.213294 -0.003935 + 8 11.488606 0.000470 + 9 25.317597 -0.000014 +S 1 + 1 0.058688 1.000000 +S 1 + 1 0.150215 1.000000 +S 1 + 1 0.324193 1.000000 +P 9 + 1 0.014848 0.009932 + 2 0.030967 0.160212 + 3 0.064586 0.389171 + 4 0.134700 0.373235 + 5 0.280932 0.195800 + 6 0.585913 0.022947 + 7 1.221985 -0.053293 + 8 2.548578 0.004846 + 9 5.315330 -0.000726 +P 1 + 1 0.034866 1.000000 +P 1 + 1 0.403929 1.000000 +P 1 + 1 0.084117 1.000000 +D 1 + 1 0.092392 1.000000 +D 1 + 1 0.245212 1.000000 +D 1 + 1 0.726318 1.000000 +F 1 + 1 0.160909 1.000000 +F 1 + 1 0.409285 1.000000 +G 1 + 1 0.352027 1.000000 +S 1 + 1 0.0183000 1.0000000 +P 1 + 1 0.0121000 1.0000000 +D 1 + 1 0.0282000 1.0000000 +F 1 + 1 0.0582000 1.0000000 +G 1 + 1 0.1530000 1.0000000 + +MAGNESIUM +S 9 + 1 0.030975 0.165290 + 2 0.062959 0.506272 + 3 0.127970 0.333197 + 4 0.260111 0.057482 + 5 0.528700 -0.137614 + 6 1.074630 -0.135378 + 7 2.184285 0.048310 + 8 4.439759 -0.005312 + 9 9.024217 0.000465 +S 1 + 1 0.023378 1.000000 +S 1 + 1 0.188141 1.000000 +S 1 + 1 0.616205 1.000000 +P 9 + 1 0.047055 1.502038 + 2 0.083253 -1.433944 + 3 0.147298 1.318987 + 4 0.260611 -0.741124 + 5 0.461094 0.436300 + 6 0.815803 -0.243798 + 7 1.443383 0.086774 + 8 2.553745 -0.028677 + 9 4.518286 0.006085 +P 1 + 1 0.089167 1.000000 +P 1 + 1 0.209210 1.000000 +P 1 + 1 0.846859 1.000000 +D 1 + 1 0.095526 1.000000 +D 1 + 1 0.734089 1.000000 +D 1 + 1 0.233222 1.000000 +F 1 + 1 0.127025 1.000000 +F 1 + 1 0.304907 1.000000 +G 1 + 1 0.192272 1.000000 +S 1 + 1 0.0123900 1.0000000 +P 1 + 1 0.0070600 1.0000000 +D 1 + 1 0.0382000 1.0000000 +F 1 + 1 0.0700000 1.0000000 +G 1 + 1 0.1480000 1.0000000 + +NITROGEN +S 9 + 1 0.098869 0.067266 + 2 0.211443 0.334290 + 3 0.452197 0.454257 + 4 0.967080 0.267861 + 5 2.068221 0.000248 + 6 4.423150 -0.132606 + 7 9.459462 0.014437 + 8 20.230246 0.000359 + 9 43.264919 -0.000094 +S 1 + 1 0.135764 1.000000 +S 1 + 1 0.310826 1.000000 +S 1 + 1 1.625001 1.000000 +P 9 + 1 0.073234 0.035758 + 2 0.145867 0.153945 + 3 0.290535 0.277656 + 4 0.578683 0.297676 + 5 1.152612 0.234403 + 6 2.295756 0.140321 + 7 4.572652 0.067219 + 8 9.107739 0.031594 + 9 18.140657 0.003301 +P 1 + 1 0.140736 1.000000 +P 1 + 1 0.413103 1.000000 +P 1 + 1 1.020750 1.000000 +D 1 + 1 0.346233 1.000000 +D 1 + 1 1.009895 1.000000 +D 1 + 1 3.028459 1.000000 +F 1 + 1 0.691129 1.000000 +F 1 + 1 2.024747 1.000000 +G 1 + 1 1.357512 1.000000 +S 1 + 1 0.0546400 1.0000000 +P 1 + 1 0.0440200 1.0000000 +D 1 + 1 0.1110000 1.0000000 +F 1 + 1 0.2450000 1.0000000 +G 1 + 1 0.5590000 1.0000000 + +FLUORINE +S 9 + 1 0.172723 0.070240 + 2 0.364875 0.311088 + 3 0.770795 0.444675 + 4 1.628295 0.287011 + 5 3.439757 0.018759 + 6 7.266451 -0.128608 + 7 15.350300 0.009104 + 8 32.427348 0.000810 + 9 68.502433 -0.000133 +S 1 + 1 0.294345 1.000000 +S 1 + 1 1.048013 1.000000 +S 1 + 1 1.705653 1.000000 +P 9 + 1 0.101001 0.035321 + 2 0.204414 0.136924 + 3 0.413707 0.249353 + 4 0.837289 0.286620 + 5 1.694565 0.254541 + 6 3.429580 0.169572 + 7 6.941026 0.088542 + 8 14.047737 0.039843 + 9 28.430799 0.003378 +P 1 + 1 0.205806 1.000000 +P 1 + 1 0.647240 1.000000 +P 1 + 1 1.650688 1.000000 +D 1 + 1 0.587354 1.000000 +D 1 + 1 1.724392 1.000000 +D 1 + 1 4.998085 1.000000 +F 1 + 1 1.178147 1.000000 +F 1 + 1 3.694285 1.000000 +G 1 + 1 2.406583 1.000000 +S 1 + 1 0.0859400 1.0000000 +P 1 + 1 0.0656800 1.0000000 +D 1 + 1 0.2070000 1.0000000 +F 1 + 1 0.4600000 1.0000000 +G 1 + 1 0.9240000 1.0000000 + +CHLORINE +S 9 + 1 0.119944 0.148917 + 2 0.257348 0.503616 + 3 0.552157 0.523995 + 4 1.184691 0.013612 + 5 2.541836 -0.328846 + 6 5.453681 0.056309 + 7 11.701243 -0.001301 + 8 25.105812 -0.000294 + 9 53.866226 0.000076 +S 1 + 1 0.161594 1.000000 +S 1 + 1 0.440111 1.000000 +S 1 + 1 0.848928 1.000000 +P 9 + 1 0.074374 0.084925 + 2 0.155084 0.270658 + 3 0.323378 0.396022 + 4 0.674303 0.324325 + 5 1.406043 0.100661 + 6 2.931855 -0.069802 + 7 6.113450 -0.000951 + 8 12.747651 0.001501 + 9 26.581165 -0.000249 +P 1 + 1 0.111309 1.000000 +P 1 + 1 1.286881 1.000000 +P 1 + 1 0.289403 1.000000 +D 1 + 1 0.253063 1.000000 +D 1 + 1 0.642589 1.000000 +D 1 + 1 1.654717 1.000000 +F 1 + 1 0.448175 1.000000 +F 1 + 1 1.189807 1.000000 +G 1 + 1 0.848307 1.000000 +S 1 + 1 0.0519000 1.0000000 +P 1 + 1 0.0376000 1.0000000 +D 1 + 1 0.0952000 1.0000000 +F 1 + 1 0.2170000 1.0000000 +G 1 + 1 0.3780000 1.0000000 + +CARBON +S 9 + 1 0.051344 0.013991 + 2 0.102619 0.169852 + 3 0.205100 0.397529 + 4 0.409924 0.380369 + 5 0.819297 0.180113 + 6 1.637494 -0.033512 + 7 3.272791 -0.121499 + 8 6.541187 0.015176 + 9 13.073594 -0.000705 +S 1 + 1 0.109576 1.000000 +S 1 + 1 0.846879 1.000000 +S 1 + 1 0.269659 1.000000 +P 9 + 1 0.029281 0.001787 + 2 0.058547 0.050426 + 3 0.117063 0.191634 + 4 0.234064 0.302667 + 5 0.468003 0.289868 + 6 0.935757 0.210979 + 7 1.871016 0.112024 + 8 3.741035 0.054425 + 9 7.480076 0.021931 +P 1 + 1 0.105389 1.000000 +P 1 + 1 0.313254 1.000000 +P 1 + 1 0.804681 1.000000 +D 1 + 1 0.240171 1.000000 +D 1 + 1 0.684884 1.000000 +D 1 + 1 2.013760 1.000000 +F 1 + 1 0.457302 1.000000 +F 1 + 1 1.324930 1.000000 +G 1 + 1 1.034180 1.000000 +S 1 + 1 0.0414500 1.0000000 +P 1 + 1 0.0321800 1.0000000 +D 1 + 1 0.0766000 1.0000000 +F 1 + 1 0.1870000 1.0000000 +G 1 + 1 0.4240000 1.0000000 + +OXYGEN +S 9 + 1 0.125346 0.055741 + 2 0.268022 0.304848 + 3 0.573098 0.453752 + 4 1.225429 0.295926 + 5 2.620277 0.019567 + 6 5.602818 -0.128627 + 7 11.980245 0.012024 + 8 25.616801 0.000407 + 9 54.775216 -0.000076 +S 1 + 1 0.224380 1.000000 +S 1 + 1 0.843157 1.000000 +S 1 + 1 1.351771 1.000000 +P 9 + 1 0.083598 0.044958 + 2 0.167017 0.150175 + 3 0.333673 0.255999 + 4 0.666627 0.281879 + 5 1.331816 0.242835 + 6 2.660761 0.161134 + 7 5.315785 0.082308 + 8 10.620108 0.039899 + 9 21.217318 0.004679 +P 1 + 1 0.148562 1.000000 +P 1 + 1 0.452364 1.000000 +P 1 + 1 1.106737 1.000000 +D 1 + 1 0.455711 1.000000 +D 1 + 1 1.344331 1.000000 +D 1 + 1 4.008867 1.000000 +F 1 + 1 0.876289 1.000000 +F 1 + 1 2.763115 1.000000 +G 1 + 1 1.759081 1.000000 +S 1 + 1 0.0695900 1.0000000 +P 1 + 1 0.0534800 1.0000000 +D 1 + 1 0.1540000 1.0000000 +F 1 + 1 0.3240000 1.0000000 +G 1 + 1 0.7140000 1.0000000 + +HYDROGEN +S 9 + 1 0.013000 0.000706 + 2 0.029900 -0.002119 + 3 0.068770 0.057693 + 4 0.158170 0.230695 + 5 0.363792 0.277612 + 6 0.836721 0.169833 + 7 1.924458 0.097443 + 8 4.426254 0.029966 + 9 10.180385 -0.000452 +S 1 + 1 0.120599 1.000000 +S 1 + 1 0.404783 1.000000 +S 1 + 1 0.715129 1.000000 +P 9 + 1 0.003000 0.001242 + 2 0.007800 -0.000913 + 3 0.020281 -0.000054 + 4 0.052730 -0.000238 + 5 0.137097 -0.011530 + 6 0.356451 -0.018235 + 7 0.926774 -0.013929 + 8 2.409612 -0.009395 + 9 6.264991 -0.000347 +P 1 + 1 0.774536 1.000000 +P 1 + 1 0.263038 1.000000 +D 1 + 1 2.315883 1.000000 +D 1 + 1 0.636656 1.000000 +F 1 + 1 1.130819 1.000000 +S 1 + 1 0.0236300 1.0000000 +P 1 + 1 0.0848000 1.0000000 +D 1 + 1 0.1900000 1.0000000 +F 1 + 1 0.3600000 1.0000000 + +PHOSPHORUS +S 9 + 1 0.074718 0.140225 + 2 0.160834 0.506746 + 3 0.346202 0.499893 + 4 0.745215 0.037301 + 5 1.604109 -0.284591 + 6 3.452917 0.024766 + 7 7.432561 0.001798 + 8 15.998924 -0.000314 + 9 34.438408 0.000088 +S 1 + 1 0.098851 1.000000 +S 1 + 1 0.255593 1.000000 +S 1 + 1 0.546057 1.000000 +P 9 + 1 0.050242 0.072095 + 2 0.102391 0.278735 + 3 0.208669 0.411034 + 4 0.425256 0.304724 + 5 0.866651 0.091727 + 6 1.766191 -0.057060 + 7 3.599410 -0.005103 + 8 7.335418 0.000328 + 9 14.949217 -0.000046 +P 1 + 1 0.074522 1.000000 +P 1 + 1 0.764539 1.000000 +P 1 + 1 0.182211 1.000000 +D 1 + 1 0.186505 1.000000 +D 1 + 1 0.502400 1.000000 +D 1 + 1 1.576445 1.000000 +F 1 + 1 0.280702 1.000000 +F 1 + 1 0.719161 1.000000 +G 1 + 1 0.599144 1.000000 +S 1 + 1 0.0354000 1.0000000 +P 1 + 1 0.0272000 1.0000000 +D 1 + 1 0.0594000 1.0000000 +F 1 + 1 0.1090000 1.0000000 +G 1 + 1 0.2500000 1.0000000 + +SILICON +S 9 + 1 0.059887 0.167492 + 2 0.130108 0.532550 + 3 0.282668 0.464290 + 4 0.614115 -0.002322 + 5 1.334205 -0.268234 + 6 2.898645 0.031921 + 7 6.297493 -0.000106 + 8 13.681707 -0.000145 + 9 29.724387 0.000067 +S 1 + 1 0.079900 1.000000 +S 1 + 1 0.206024 1.000000 +S 1 + 1 0.435017 1.000000 +P 9 + 1 0.036525 0.078761 + 2 0.076137 0.308331 + 3 0.158712 0.417773 + 4 0.330843 0.281676 + 5 0.689658 0.069876 + 6 1.437625 -0.056306 + 7 2.996797 0.000744 + 8 6.246966 -0.000259 + 9 13.022097 -0.000022 +P 1 + 1 0.054575 1.000000 +P 1 + 1 0.599112 1.000000 +P 1 + 1 0.134681 1.000000 +D 1 + 1 0.133118 1.000000 +D 1 + 1 0.350967 1.000000 +D 1 + 1 1.063961 1.000000 +F 1 + 1 0.211319 1.000000 +F 1 + 1 0.535932 1.000000 +G 1 + 1 0.465365 1.000000 +S 1 + 1 0.0275000 1.0000000 +P 1 + 1 0.0200000 1.0000000 +D 1 + 1 0.0435000 1.0000000 +F 1 + 1 0.0846000 1.0000000 +G 1 + 1 0.2120000 1.0000000 + +ARGON +S 9 + 1 0.147347 0.155473 + 2 0.312164 0.494617 + 3 0.661339 0.526705 + 4 1.401090 0.021986 + 5 2.968301 -0.338533 + 6 6.288539 0.056023 + 7 13.322677 -0.000115 + 8 28.224956 -0.000595 + 9 59.796402 0.000127 +S 1 + 1 0.196024 1.000000 +S 1 + 1 0.540061 1.000000 +S 1 + 1 1.020348 1.000000 +P 9 + 1 0.090580 0.079101 + 2 0.188085 0.260718 + 3 0.390548 0.395065 + 4 0.810953 0.334954 + 5 1.683902 0.107462 + 6 3.496535 -0.073657 + 7 7.260371 -0.001407 + 8 15.075781 0.001710 + 9 31.304069 -0.000275 +P 1 + 1 0.140701 1.000000 +P 1 + 1 1.604300 1.000000 +P 1 + 1 0.367738 1.000000 +D 1 + 1 0.304103 1.000000 +D 1 + 1 0.760464 1.000000 +D 1 + 1 1.900944 1.000000 +F 1 + 1 0.583628 1.000000 +F 1 + 1 1.480507 1.000000 +G 1 + 1 1.030824 1.000000 +S 1 + 1 0.0610000 1.0000000 +P 1 + 1 0.0435000 1.0000000 +D 1 + 1 0.1160000 1.0000000 +F 1 + 1 0.2940000 1.0000000 +G 1 + 1 0.4590000 1.0000000 + +SODIUM +S 9 + 1 0.013061 0.200118 + 2 0.030041 0.467652 + 3 0.069092 0.227738 + 4 0.158908 -0.061581 + 5 0.365481 -0.137533 + 6 0.840589 0.003323 + 7 1.933315 0.003741 + 8 4.446533 -0.001117 + 9 10.226816 0.000244 +S 1 + 1 0.064915 1.000000 +S 1 + 1 1.134458 1.000000 +S 1 + 1 0.771046 1.000000 +P 9 + 1 0.002593 -0.002840 + 2 0.006741 0.005340 + 3 0.017525 -0.025936 + 4 0.045563 -0.053466 + 5 0.118461 -0.053691 + 6 0.307987 0.014439 + 7 0.800738 0.006199 + 8 2.081847 -0.001026 + 9 5.412617 0.000168 +P 1 + 1 0.059662 1.000000 +P 1 + 1 0.096714 1.000000 +P 1 + 1 0.552976 1.000000 +D 1 + 1 0.046917 1.000000 +D 1 + 1 0.813868 1.000000 +D 1 + 1 0.127780 1.000000 +F 1 + 1 0.129992 1.000000 +F 1 + 1 0.626429 1.000000 +G 1 + 1 0.588778 1.000000 +S 1 + 1 0.0050300 1.0000000 +P 1 + 1 0.0077200 1.0000000 +D 1 + 1 0.0210000 1.0000000 +F 1 + 1 0.0453000 1.0000000 +G 1 + 1 0.0866000 1.0000000 + +BERYLLIUM +S 9 + 1 0.030068 0.025105 + 2 0.054002 0.178890 + 3 0.096986 0.263939 + 4 0.174186 0.435946 + 5 0.312836 -0.008188 + 6 0.561850 0.049509 + 7 1.009077 -0.114576 + 8 1.812290 -0.067207 + 9 3.254852 0.017250 +S 1 + 1 0.012287 1.000000 +S 1 + 1 0.175341 1.000000 +S 1 + 1 1.244398 1.000000 +P 9 + 1 0.015064 0.735052 + 2 0.028584 -0.476214 + 3 0.054236 0.564806 + 4 0.102911 -0.108575 + 5 0.195269 0.233862 + 6 0.370513 -0.009003 + 7 0.703030 0.067510 + 8 1.333967 -0.002868 + 9 2.531139 0.017869 +P 1 + 1 0.317061 1.000000 +P 1 + 1 1.585739 1.000000 +P 1 + 1 0.108346 1.000000 +D 1 + 1 0.125228 1.000000 +D 1 + 1 0.801065 1.000000 +D 1 + 1 0.301656 1.000000 +F 1 + 1 0.153439 1.000000 +F 1 + 1 0.377536 1.000000 +G 1 + 1 0.338801 1.000000 +S 1 + 1 0.0143900 1.0000000 +P 1 + 1 0.0065000 1.0000000 +D 1 + 1 0.0554000 1.0000000 +F 1 + 1 0.0930000 1.0000000 +G 1 + 1 0.1834000 1.0000000 + +SULFUR +S 9 + 1 0.095120 0.140074 + 2 0.202385 0.490942 + 3 0.430611 0.515297 + 4 0.916203 0.050320 + 5 1.949388 -0.298908 + 6 4.147674 0.019827 + 7 8.824926 0.007266 + 8 18.776623 -0.001602 + 9 39.950656 0.000271 +S 1 + 1 0.123759 1.000000 +S 1 + 1 0.315587 1.000000 +S 1 + 1 0.651905 1.000000 +P 9 + 1 0.057087 0.081938 + 2 0.115901 0.251826 + 3 0.235305 0.376344 + 4 0.477723 0.320902 + 5 0.969889 0.143779 + 6 1.969099 -0.045543 + 7 3.997726 -0.017191 + 8 8.116307 0.002580 + 9 16.477979 -0.000222 +P 1 + 1 0.078717 1.000000 +P 1 + 1 0.202707 1.000000 +P 1 + 1 0.301333 1.000000 +D 1 + 1 0.215701 1.000000 +D 1 + 1 0.560638 1.000000 +D 1 + 1 1.588204 1.000000 +F 1 + 1 0.356554 1.000000 +F 1 + 1 0.961826 1.000000 +G 1 + 1 0.694803 1.000000 +S 1 + 1 0.0428000 1.0000000 +P 1 + 1 0.0317000 1.0000000 +D 1 + 1 0.0748000 1.0000000 +F 1 + 1 0.1400000 1.0000000 +G 1 + 1 0.2970000 1.0000000 + +HELIUM +S 9 + 1 0.077786 0.012425 + 2 0.161528 0.128251 + 3 0.335425 0.282221 + 4 0.696535 0.292427 + 5 1.446408 0.215025 + 6 3.003576 0.125450 + 7 6.237154 0.064912 + 8 12.951926 0.038892 + 9 26.895662 0.002531 +S 1 + 1 0.937228 1.000000 +S 1 + 1 1.223567 1.000000 +S 1 + 1 0.229163 1.000000 +P 8 + 1 0.228528 -0.000116 + 2 0.422019 2.116950 + 3 0.779333 -2.182954 + 4 1.439180 1.545850 + 5 2.657706 -0.879477 + 6 4.907934 0.469710 + 7 9.063386 -0.224631 + 8 16.737180 0.098422 +P 1 + 1 3.888767 1.000000 +P 1 + 1 1.015492 1.000000 +D 1 + 1 0.939402 1.000000 +D 1 + 1 3.054371 1.000000 +F 1 + 1 1.021427 1.000000 +S 1 + 1 0.0481900 1.0000000 +P 1 + 1 0.1626000 1.0000000 +D 1 + 1 0.3510000 1.0000000 +F 1 + 1 0.6906000 1.0000000 + + diff --git a/data/basis/avtz-bfd b/data/basis/avtz-bfd new file mode 100644 index 00000000..5374d00f --- /dev/null +++ b/data/basis/avtz-bfd @@ -0,0 +1,1038 @@ +ARSENIC +S 9 + 1 0.079412 0.192043 + 2 0.178687 0.611682 + 3 0.402068 0.439261 + 4 0.904702 -0.110280 + 5 2.035691 -0.394179 + 6 4.580555 0.145632 + 7 10.306811 -0.021379 + 8 23.191593 0.003205 + 9 52.183937 -0.000469 +S 1 + 1 0.113088 1.000000 +S 1 + 1 0.540159 1.000000 +P 9 + 1 0.050626 0.105058 + 2 0.108692 0.361819 + 3 0.233354 0.452107 + 4 0.500995 0.231243 + 5 1.075603 -0.009549 + 6 2.309248 -0.121767 + 7 4.957802 0.028648 + 8 10.644071 -0.002941 + 9 22.852115 0.000293 +P 1 + 1 0.612326 1.000000 +P 1 + 1 0.100851 1.000000 +D 1 + 1 0.165790 1.000000 +D 1 + 1 0.412063 1.000000 +F 1 + 1 0.425290 1.000000 +S 1 + 1 0.0334070 1.0000000 +P 1 + 1 0.0267990 1.0000000 +D 1 + 1 0.0700000 1.0000000 +F 1 + 1 0.1690000 1.0000000 + +LITHIUM +S 9 + 1 0.010125 0.007841 + 2 0.023437 0.258118 + 3 0.054251 0.423307 + 4 0.125581 0.167825 + 5 0.290697 -0.068332 + 6 0.672909 -0.119269 + 7 1.557659 0.007736 + 8 3.605689 0.003630 + 9 8.346494 -0.000646 +S 1 + 1 0.026170 1.000000 +S 1 + 1 0.132259 1.000000 +P 9 + 1 0.018300 -0.005906 + 2 0.031699 -0.031422 + 3 0.054908 -0.043628 + 4 0.095111 -0.016781 + 5 0.164751 -0.078594 + 6 0.285379 0.015562 + 7 0.494330 -0.030830 + 8 0.856273 0.006185 + 9 1.483225 -0.008621 +P 1 + 1 0.052959 1.000000 +P 1 + 1 0.110075 1.000000 +D 1 + 1 0.067795 1.000000 +D 1 + 1 0.177140 1.000000 +F 1 + 1 0.180758 1.000000 +S 1 + 1 0.0076000 1.0000000 +P 1 + 1 0.0091000 1.0000000 +D 1 + 1 0.0371000 1.0000000 +F 1 + 1 0.0816000 1.0000000 + +GERMANIUM +S 9 + 1 0.066287 0.213230 + 2 0.150128 0.605570 + 3 0.340013 0.413442 + 4 0.770064 -0.106356 + 5 1.744049 -0.364579 + 6 3.949940 0.127448 + 7 8.945864 -0.017166 + 8 20.260687 0.002454 + 9 45.886614 -0.000355 +S 1 + 1 0.091049 1.000000 +S 1 + 1 0.445676 1.000000 +P 9 + 1 0.036511 0.098680 + 2 0.080524 0.372290 + 3 0.177593 0.443836 + 4 0.391677 0.232585 + 5 0.863832 0.000058 + 6 1.905157 -0.108282 + 7 4.201772 0.021894 + 8 9.266892 -0.001911 + 9 20.437873 0.000181 +P 1 + 1 0.040412 1.000000 +P 1 + 1 0.092450 1.000000 +D 1 + 1 0.130147 1.000000 +D 1 + 1 0.323826 1.000000 +F 1 + 1 0.352814 1.000000 +S 1 + 1 0.0273700 1.0000000 +P 1 + 1 0.0213680 1.0000000 +D 1 + 1 0.0528000 1.0000000 +F 1 + 1 0.1323000 1.0000000 + +NEON +S 9 + 1 0.205835 0.057514 + 2 0.391384 0.215776 + 3 0.744196 0.374799 + 4 1.415048 0.326313 + 5 2.690638 0.166383 + 6 5.116103 -0.039149 + 7 9.727994 -0.085909 + 8 18.497256 0.006816 + 9 35.171534 0.000206 +S 1 + 1 0.317767 1.000000 +S 1 + 1 0.534557 1.000000 +P 9 + 1 0.121772 0.029943 + 2 0.238248 0.114200 + 3 0.466136 0.219618 + 4 0.912002 0.268864 + 5 1.784344 0.256932 + 6 3.491095 0.191378 + 7 6.830378 0.112176 + 8 13.363732 0.063317 + 9 26.146332 0.008057 +P 1 + 1 0.294665 1.000000 +P 1 + 1 0.962126 1.000000 +D 1 + 1 1.134063 1.000000 +D 1 + 1 4.161437 1.000000 +F 1 + 1 2.556751 1.000000 +S 1 + 1 0.1133000 1.0000000 +P 1 + 1 0.0917500 1.0000000 +D 1 + 1 0.3860000 1.0000000 +F 1 + 1 1.0840000 1.0000000 + +BORON +S 9 + 1 0.040569 0.032031 + 2 0.081044 0.243317 + 3 0.161898 0.434636 + 4 0.323418 0.329581 + 5 0.646080 0.111875 + 6 1.290648 -0.078699 + 7 2.578276 -0.098781 + 8 5.150520 0.016164 + 9 10.288990 -0.000016 +S 1 + 1 0.626026 1.000000 +S 1 + 1 0.092094 1.000000 +P 9 + 1 0.029207 0.019909 + 2 0.058408 0.141775 + 3 0.116803 0.294463 + 4 0.233582 0.309028 + 5 0.467115 0.236378 + 6 0.934132 0.131317 + 7 1.868068 0.066454 + 8 3.735743 0.021248 + 9 7.470701 0.002837 +P 1 + 1 0.082056 1.000000 +P 1 + 1 0.235016 1.000000 +D 1 + 1 0.207316 1.000000 +D 1 + 1 0.699153 1.000000 +F 1 + 1 0.478872 1.000000 +S 1 + 1 0.0291400 1.0000000 +P 1 + 1 0.0209600 1.0000000 +D 1 + 1 0.0604000 1.0000000 +F 1 + 1 0.1630000 1.0000000 + +GALLIUM +S 9 + 1 0.054628 0.253171 + 2 0.123743 0.598295 + 3 0.280299 0.356909 + 4 0.634926 -0.056544 + 5 1.438218 -0.411266 + 6 3.257814 0.156079 + 7 7.379514 -0.025142 + 8 16.715879 0.004089 + 9 37.864367 -0.000622 +S 1 + 1 0.069703 1.000000 +S 1 + 1 0.341994 1.000000 +P 9 + 1 0.029207 0.759400 + 2 0.064420 -0.022059 + 3 0.142086 0.368252 + 4 0.313389 0.051142 + 5 0.691221 0.036655 + 6 1.524577 -0.078589 + 7 3.362652 0.017781 + 8 7.416764 -0.002498 + 9 16.358632 0.000386 +P 1 + 1 0.027309 1.000000 +P 1 + 1 0.064029 1.000000 +D 1 + 1 0.105092 1.000000 +D 1 + 1 0.266379 1.000000 +F 1 + 1 0.297554 1.000000 +S 1 + 1 0.0143980 1.0000000 +P 1 + 1 0.0193000 1.0000000 +D 1 + 1 0.0387000 1.0000000 +F 1 + 1 0.0980000 1.0000000 + +ALUMINUM +S 9 + 1 0.045518 0.206193 + 2 0.100308 0.559887 + 3 0.221051 0.407852 + 4 0.487132 -0.041098 + 5 1.073500 -0.238652 + 6 2.365686 0.038132 + 7 5.213294 -0.003935 + 8 11.488606 0.000470 + 9 25.317597 -0.000014 +S 1 + 1 0.064303 1.000000 +S 1 + 1 0.371009 1.000000 +P 9 + 1 0.014848 0.009932 + 2 0.030967 0.160212 + 3 0.064586 0.389171 + 4 0.134700 0.373235 + 5 0.280932 0.195800 + 6 0.585913 0.022947 + 7 1.221985 -0.053293 + 8 2.548578 0.004846 + 9 5.315330 -0.000726 +P 1 + 1 0.035607 1.000000 +P 1 + 1 0.090801 1.000000 +D 1 + 1 0.115540 1.000000 +D 1 + 1 0.359082 1.000000 +F 1 + 1 0.254838 1.000000 +S 1 + 1 0.0221000 1.0000000 +P 1 + 1 0.0146000 1.0000000 +D 1 + 1 0.0356000 1.0000000 +F 1 + 1 0.0858000 1.0000000 + +MAGNESIUM +S 9 + 1 0.030975 0.165290 + 2 0.062959 0.506272 + 3 0.127970 0.333197 + 4 0.260111 0.057482 + 5 0.528700 -0.137614 + 6 1.074630 -0.135378 + 7 2.184285 0.048310 + 8 4.439759 -0.005312 + 9 9.024217 0.000465 +S 1 + 1 0.153453 1.000000 +S 1 + 1 0.673960 1.000000 +P 9 + 1 0.047055 1.502038 + 2 0.083253 -1.433944 + 3 0.147298 1.318987 + 4 0.260611 -0.741124 + 5 0.461094 0.436300 + 6 0.815803 -0.243798 + 7 1.443383 0.086774 + 8 2.553745 -0.028677 + 9 4.518286 0.006085 +P 1 + 1 0.126917 1.000000 +P 1 + 1 1.118965 1.000000 +D 1 + 1 0.095734 1.000000 +D 1 + 1 0.274572 1.000000 +F 1 + 1 0.148519 1.000000 +S 1 + 1 0.0129000 1.0000000 +P 1 + 1 0.0074500 1.0000000 +D 1 + 1 0.0468000 1.0000000 +F 1 + 1 0.0940000 1.0000000 + +NITROGEN +S 9 + 1 0.098869 0.067266 + 2 0.211443 0.334290 + 3 0.452197 0.454257 + 4 0.967080 0.267861 + 5 2.068221 0.000248 + 6 4.423150 -0.132606 + 7 9.459462 0.014437 + 8 20.230246 0.000359 + 9 43.264919 -0.000094 +S 1 + 1 1.202183 1.000000 +S 1 + 1 0.163243 1.000000 +P 9 + 1 0.073234 0.035758 + 2 0.145867 0.153945 + 3 0.290535 0.277656 + 4 0.578683 0.297676 + 5 1.152612 0.234403 + 6 2.295756 0.140321 + 7 4.572652 0.067219 + 8 9.107739 0.031594 + 9 18.140657 0.003301 +P 1 + 1 0.170104 1.000000 +P 1 + 1 0.517547 1.000000 +D 1 + 1 0.483567 1.000000 +D 1 + 1 1.712416 1.000000 +F 1 + 1 1.093097 1.000000 +S 1 + 1 0.0576000 1.0000000 +P 1 + 1 0.0491000 1.0000000 +D 1 + 1 0.1510000 1.0000000 +F 1 + 1 0.3640000 1.0000000 + +BROMINE +S 9 + 1 0.114626 0.199832 + 2 0.253024 0.605806 + 3 0.558520 0.486414 + 4 1.232866 -0.208964 + 5 2.721403 -0.328448 + 6 6.007171 0.118471 + 7 13.260109 -0.013112 + 8 29.270100 0.001206 + 9 64.610234 -0.000121 +S 1 + 1 0.154401 1.000000 +S 1 + 1 0.660618 1.000000 +P 9 + 1 0.067990 0.107992 + 2 0.145507 0.331860 + 3 0.311403 0.442871 + 4 0.666441 0.283256 + 5 1.426267 -0.026045 + 6 3.052389 -0.111323 + 7 6.532494 0.021712 + 8 13.980353 -0.001188 + 9 29.919703 0.000022 +P 1 + 1 0.078655 1.000000 +P 1 + 1 0.164043 1.000000 +D 1 + 1 0.234980 1.000000 +D 1 + 1 0.568017 1.000000 +F 1 + 1 0.555711 1.000000 +S 1 + 1 0.0455930 1.0000000 +P 1 + 1 0.0351420 1.0000000 +D 1 + 1 0.1047000 1.0000000 +F 1 + 1 0.2580000 1.0000000 + +FLUORINE +S 9 + 1 0.172723 0.070240 + 2 0.364875 0.311088 + 3 0.770795 0.444675 + 4 1.628295 0.287011 + 5 3.439757 0.018759 + 6 7.266451 -0.128608 + 7 15.350300 0.009104 + 8 32.427348 0.000810 + 9 68.502433 -0.000133 +S 1 + 1 2.289795 1.000000 +S 1 + 1 0.327712 1.000000 +P 9 + 1 0.101001 0.035321 + 2 0.204414 0.136924 + 3 0.413707 0.249353 + 4 0.837289 0.286620 + 5 1.694565 0.254541 + 6 3.429580 0.169572 + 7 6.941026 0.088542 + 8 14.047737 0.039843 + 9 28.430799 0.003378 +P 1 + 1 0.243660 1.000000 +P 1 + 1 0.804181 1.000000 +D 1 + 1 0.900763 1.000000 +D 1 + 1 3.297425 1.000000 +F 1 + 1 1.859274 1.000000 +S 1 + 1 0.0915800 1.0000000 +P 1 + 1 0.0736100 1.0000000 +D 1 + 1 0.2920000 1.0000000 +F 1 + 1 0.7240000 1.0000000 + +CHLORINE +S 9 + 1 0.119944 0.148917 + 2 0.257348 0.503616 + 3 0.552157 0.523995 + 4 1.184691 0.013612 + 5 2.541836 -0.328846 + 6 5.453681 0.056309 + 7 11.701243 -0.001301 + 8 25.105812 -0.000294 + 9 53.866226 0.000076 +S 1 + 1 0.185613 1.000000 +S 1 + 1 0.991560 1.000000 +P 9 + 1 0.074374 0.084925 + 2 0.155084 0.270658 + 3 0.323378 0.396022 + 4 0.674303 0.324325 + 5 1.406043 0.100661 + 6 2.931855 -0.069802 + 7 6.113450 -0.000951 + 8 12.747651 0.001501 + 9 26.581165 -0.000249 +P 1 + 1 0.112268 1.000000 +P 1 + 1 0.309583 1.000000 +D 1 + 1 0.352357 1.000000 +D 1 + 1 1.128796 1.000000 +F 1 + 1 0.731999 1.000000 +S 1 + 1 0.0591000 1.0000000 +P 1 + 1 0.0419000 1.0000000 +D 1 + 1 0.1350000 1.0000000 +F 1 + 1 0.3120000 1.0000000 + +CARBON +S 9 + 1 0.051344 0.013991 + 2 0.102619 0.169852 + 3 0.205100 0.397529 + 4 0.409924 0.380369 + 5 0.819297 0.180113 + 6 1.637494 -0.033512 + 7 3.272791 -0.121499 + 8 6.541187 0.015176 + 9 13.073594 -0.000705 +S 1 + 1 0.921552 1.000000 +S 1 + 1 0.132800 1.000000 +P 9 + 1 0.029281 0.001787 + 2 0.058547 0.050426 + 3 0.117063 0.191634 + 4 0.234064 0.302667 + 5 0.468003 0.289868 + 6 0.935757 0.210979 + 7 1.871016 0.112024 + 8 3.741035 0.054425 + 9 7.480076 0.021931 +P 1 + 1 0.126772 1.000000 +P 1 + 1 0.376742 1.000000 +D 1 + 1 0.329486 1.000000 +D 1 + 1 1.141611 1.000000 +F 1 + 1 0.773485 1.000000 +S 1 + 1 0.0440200 1.0000000 +P 1 + 1 0.0356900 1.0000000 +D 1 + 1 0.1000000 1.0000000 +F 1 + 1 0.2680000 1.0000000 + +OXYGEN +S 9 + 1 0.125346 0.055741 + 2 0.268022 0.304848 + 3 0.573098 0.453752 + 4 1.225429 0.295926 + 5 2.620277 0.019567 + 6 5.602818 -0.128627 + 7 11.980245 0.012024 + 8 25.616801 0.000407 + 9 54.775216 -0.000076 +S 1 + 1 1.686633 1.000000 +S 1 + 1 0.237997 1.000000 +P 9 + 1 0.083598 0.044958 + 2 0.167017 0.150175 + 3 0.333673 0.255999 + 4 0.666627 0.281879 + 5 1.331816 0.242835 + 6 2.660761 0.161134 + 7 5.315785 0.082308 + 8 10.620108 0.039899 + 9 21.217318 0.004679 +P 1 + 1 0.184696 1.000000 +P 1 + 1 0.600621 1.000000 +D 1 + 1 0.669340 1.000000 +D 1 + 1 2.404278 1.000000 +F 1 + 1 1.423104 1.000000 +S 1 + 1 0.0737600 1.0000000 +P 1 + 1 0.0597400 1.0000000 +D 1 + 1 0.2140000 1.0000000 +F 1 + 1 0.5000000 1.0000000 + +KRYPTON +S 9 + 1 0.129911 0.183453 + 2 0.282220 0.596016 + 3 0.613098 0.506410 + 4 1.331901 -0.150926 + 5 2.893437 -0.423611 + 6 6.285735 0.162644 + 7 13.655203 -0.023284 + 8 29.664719 0.003157 + 9 64.443973 -0.000422 +S 1 + 1 0.179349 1.000000 +S 1 + 1 0.755436 1.000000 +P 9 + 1 0.079314 0.096705 + 2 0.167216 0.312567 + 3 0.352539 0.448237 + 4 0.743252 0.298640 + 5 1.566988 -0.003641 + 6 3.303659 -0.138798 + 7 6.965055 0.029989 + 8 14.684325 -0.002578 + 9 30.958748 0.000205 +P 1 + 1 0.094685 1.000000 +P 1 + 1 0.189991 1.000000 +D 1 + 1 0.279731 1.000000 +D 1 + 1 0.675347 1.000000 +F 1 + 1 0.685639 1.000000 +S 1 + 1 0.0519850 1.0000000 +P 1 + 1 0.0400330 1.0000000 +D 1 + 1 0.1257000 1.0000000 +F 1 + 1 0.3280000 1.0000000 + +HYDROGEN +S 9 + 1 0.013000 0.000706 + 2 0.029900 -0.002119 + 3 0.068770 0.057693 + 4 0.158170 0.230695 + 5 0.363792 0.277612 + 6 0.836721 0.169833 + 7 1.924458 0.097443 + 8 4.426254 0.029966 + 9 10.180385 -0.000452 +S 1 + 1 0.170654 1.000000 +P 9 + 1 0.003000 0.001242 + 2 0.007800 -0.000913 + 3 0.020281 -0.000054 + 4 0.052730 -0.000238 + 5 0.137097 -0.011530 + 6 0.356451 -0.018235 + 7 0.926774 -0.013929 + 8 2.409612 -0.009395 + 9 6.264991 -0.000347 +P 1 + 1 0.495357 1.000000 +D 1 + 1 0.955745 1.000000 +S 1 + 1 0.0252600 1.0000000 +P 1 + 1 0.1020000 1.0000000 +D 1 + 1 0.2470000 1.0000000 + +PHOSPHORUS +S 9 + 1 0.074718 0.140225 + 2 0.160834 0.506746 + 3 0.346202 0.499893 + 4 0.745215 0.037301 + 5 1.604109 -0.284591 + 6 3.452917 0.024766 + 7 7.432561 0.001798 + 8 15.998924 -0.000314 + 9 34.438408 0.000088 +S 1 + 1 0.115288 1.000000 +S 1 + 1 0.646066 1.000000 +P 9 + 1 0.050242 0.072095 + 2 0.102391 0.278735 + 3 0.208669 0.411034 + 4 0.425256 0.304724 + 5 0.866651 0.091727 + 6 1.766191 -0.057060 + 7 3.599410 -0.005103 + 8 7.335418 0.000328 + 9 14.949217 -0.000046 +P 1 + 1 0.076568 1.000000 +P 1 + 1 0.200301 1.000000 +D 1 + 1 0.234543 1.000000 +D 1 + 1 0.753299 1.000000 +F 1 + 1 0.468762 1.000000 +S 1 + 1 0.0409000 1.0000000 +P 1 + 1 0.0307000 1.0000000 +D 1 + 1 0.0775000 1.0000000 +F 1 + 1 0.1650000 1.0000000 + +SILICON +S 9 + 1 0.059887 0.167492 + 2 0.130108 0.532550 + 3 0.282668 0.464290 + 4 0.614115 -0.002322 + 5 1.334205 -0.268234 + 6 2.898645 0.031921 + 7 6.297493 -0.000106 + 8 13.681707 -0.000145 + 9 29.724387 0.000067 +S 1 + 1 0.090113 1.000000 +S 1 + 1 0.507467 1.000000 +P 9 + 1 0.036525 0.078761 + 2 0.076137 0.308331 + 3 0.158712 0.417773 + 4 0.330843 0.281676 + 5 0.689658 0.069876 + 6 1.437625 -0.056306 + 7 2.996797 0.000744 + 8 6.246966 -0.000259 + 9 13.022097 -0.000022 +P 1 + 1 0.056148 1.000000 +P 1 + 1 0.146758 1.000000 +D 1 + 1 0.170395 1.000000 +D 1 + 1 0.539756 1.000000 +F 1 + 1 0.352999 1.000000 +S 1 + 1 0.0330000 1.0000000 +P 1 + 1 0.0237000 1.0000000 +D 1 + 1 0.0556000 1.0000000 +F 1 + 1 0.1250000 1.0000000 + +ARGON +S 9 + 1 0.147347 0.155473 + 2 0.312164 0.494617 + 3 0.661339 0.526705 + 4 1.401090 0.021986 + 5 2.968301 -0.338533 + 6 6.288539 0.056023 + 7 13.322677 -0.000115 + 8 28.224956 -0.000595 + 9 59.796402 0.000127 +S 1 + 1 0.228740 1.000000 +S 1 + 1 1.191630 1.000000 +P 9 + 1 0.090580 0.079101 + 2 0.188085 0.260718 + 3 0.390548 0.395065 + 4 0.810953 0.334954 + 5 1.683902 0.107462 + 6 3.496535 -0.073657 + 7 7.260371 -0.001407 + 8 15.075781 0.001710 + 9 31.304069 -0.000275 +P 1 + 1 0.138338 1.000000 +P 1 + 1 0.380189 1.000000 +D 1 + 1 0.425779 1.000000 +D 1 + 1 1.370859 1.000000 +F 1 + 1 0.929931 1.000000 +S 1 + 1 0.0685000 1.0000000 +P 1 + 1 0.0487000 1.0000000 +D 1 + 1 0.1690000 1.0000000 +F 1 + 1 0.4060000 1.0000000 + +SODIUM +S 9 + 1 0.013061 0.200118 + 2 0.030041 0.467652 + 3 0.069092 0.227738 + 4 0.158908 -0.061581 + 5 0.365481 -0.137533 + 6 0.840589 0.003323 + 7 1.933315 0.003741 + 8 4.446533 -0.001117 + 9 10.226816 0.000244 +S 1 + 1 0.067854 1.000000 +S 1 + 1 0.550451 1.000000 +P 9 + 1 0.002593 -0.002840 + 2 0.006741 0.005340 + 3 0.017525 -0.025936 + 4 0.045563 -0.053466 + 5 0.118461 -0.053691 + 6 0.307987 0.014439 + 7 0.800738 0.006199 + 8 2.081847 -0.001026 + 9 5.412617 0.000168 +P 1 + 1 0.089406 1.000000 +P 1 + 1 0.619273 1.000000 +D 1 + 1 0.086920 1.000000 +D 1 + 1 0.693014 1.000000 +F 1 + 1 0.132402 1.000000 +S 1 + 1 0.0066500 1.0000000 +P 1 + 1 0.0070000 1.0000000 +D 1 + 1 0.0223000 1.0000000 +F 1 + 1 0.0714000 1.0000000 + +BERYLLIUM +S 9 + 1 0.030068 0.025105 + 2 0.054002 0.178890 + 3 0.096986 0.263939 + 4 0.174186 0.435946 + 5 0.312836 -0.008188 + 6 0.561850 0.049509 + 7 1.009077 -0.114576 + 8 1.812290 -0.067207 + 9 3.254852 0.017250 +S 1 + 1 0.060913 1.000000 +S 1 + 1 0.357735 1.000000 +P 9 + 1 0.015064 0.735052 + 2 0.028584 -0.476214 + 3 0.054236 0.564806 + 4 0.102911 -0.108575 + 5 0.195269 0.233862 + 6 0.370513 -0.009003 + 7 0.703030 0.067510 + 8 1.333967 -0.002868 + 9 2.531139 0.017869 +P 1 + 1 0.728274 1.000000 +P 1 + 1 0.165173 1.000000 +D 1 + 1 0.113241 1.000000 +D 1 + 1 0.305198 1.000000 +F 1 + 1 0.272841 1.000000 +S 1 + 1 0.0150300 1.0000000 +P 1 + 1 0.0070600 1.0000000 +D 1 + 1 0.0654000 1.0000000 +F 1 + 1 0.1533000 1.0000000 + +SELENIUM +S 9 + 1 0.096883 0.200965 + 2 0.217674 0.615093 + 3 0.489067 0.462636 + 4 1.098828 -0.204179 + 5 2.468828 -0.307584 + 6 5.546920 0.109895 + 7 12.462726 -0.012288 + 8 28.001040 0.001205 + 9 62.912258 -0.000132 +S 1 + 1 0.130387 1.000000 +S 1 + 1 0.584755 1.000000 +P 9 + 1 0.056147 0.073504 + 2 0.122259 0.334692 + 3 0.266220 0.473323 + 4 0.579694 0.276571 + 5 1.262286 -0.032356 + 6 2.748631 -0.103709 + 7 5.985152 0.020181 + 8 13.032685 -0.001095 + 9 28.378708 0.000019 +P 1 + 1 0.069683 1.000000 +P 1 + 1 0.141231 1.000000 +D 1 + 1 0.195235 1.000000 +D 1 + 1 0.471051 1.000000 +F 1 + 1 0.466246 1.000000 +S 1 + 1 0.0392010 1.0000000 +P 1 + 1 0.0302510 1.0000000 +D 1 + 1 0.0837000 1.0000000 +F 1 + 1 0.1880000 1.0000000 + +SULFUR +S 9 + 1 0.095120 0.140074 + 2 0.202385 0.490942 + 3 0.430611 0.515297 + 4 0.916203 0.050320 + 5 1.949388 -0.298908 + 6 4.147674 0.019827 + 7 8.824926 0.007266 + 8 18.776623 -0.001602 + 9 39.950656 0.000271 +S 1 + 1 0.146642 1.000000 +S 1 + 1 0.792025 1.000000 +P 9 + 1 0.057087 0.081938 + 2 0.115901 0.251826 + 3 0.235305 0.376344 + 4 0.477723 0.320902 + 5 0.969889 0.143779 + 6 1.969099 -0.045543 + 7 3.997726 -0.017191 + 8 8.116307 0.002580 + 9 16.477979 -0.000222 +P 1 + 1 0.088694 1.000000 +P 1 + 1 0.247967 1.000000 +D 1 + 1 0.292889 1.000000 +D 1 + 1 0.950659 1.000000 +F 1 + 1 0.573218 1.000000 +S 1 + 1 0.0497000 1.0000000 +P 1 + 1 0.0351000 1.0000000 +D 1 + 1 0.1010000 1.0000000 +F 1 + 1 0.2180000 1.0000000 + +HELIUM +S 9 + 1 0.077786 0.012425 + 2 0.161528 0.128251 + 3 0.335425 0.282221 + 4 0.696535 0.292427 + 5 1.446408 0.215025 + 6 3.003576 0.125450 + 7 6.237154 0.064912 + 8 12.951926 0.038892 + 9 26.895662 0.002531 +S 1 + 1 0.667868 1.000000 +S 1 + 1 0.224485 1.000000 +P 8 + 1 0.228528 -0.000116 + 2 0.422019 2.116950 + 3 0.779333 -2.182954 + 4 1.439180 1.545850 + 5 2.657706 -0.879477 + 6 4.907934 0.469710 + 7 9.063386 -0.224631 + 8 16.737180 0.098422 +P 1 + 1 1.492028 1.000000 +D 1 + 1 1.913792 1.000000 +S 1 + 1 0.0513800 1.0000000 +P 1 + 1 0.1993000 1.0000000 +D 1 + 1 0.4592000 1.0000000 + + From b3bade7c9fad9f126d6cf6791fc8da121403f40b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 20 Mar 2018 08:52:46 +0100 Subject: [PATCH 53/65] debug in abort --- src/ZMQ/utils.irp.f | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index 570cf30f..804df09f 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -761,6 +761,7 @@ integer function add_task_to_taskserver(zmq_to_qp_run_socket,task) rc = f77_zmq_recv(zmq_to_qp_run_socket, message, sze-1, 0) if (message(1:rc) /= 'ok') then + print *, 'add_task_to_taskserver: '//trim(message(1:rc)) add_task_to_taskserver = -1 return endif @@ -790,6 +791,7 @@ integer function zmq_abort(zmq_to_qp_run_socket) rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) if (trim(message(1:rc)) /= 'ok') then + print *, 'zmq_abort: '//trim(message(1:rc)) zmq_abort = -1 return endif @@ -821,6 +823,7 @@ integer function task_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_i rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) if (trim(message(1:rc)) /= 'ok') then + print *, 'task_done_to_taskserver: '//trim(message(1:rc)) task_done_to_taskserver = -1 return endif @@ -862,6 +865,7 @@ integer function tasks_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_ rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 64, 0) if (trim(message(1:rc)) /= 'ok') then + print *, 'tasks_done_to_taskserver: '//trim(message(1:rc)) tasks_done_to_taskserver = -1 endif deallocate(message) From 437df9439dd91e684b2a1f2a2ad28ac836069cdd Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 20 Mar 2018 13:11:53 +0100 Subject: [PATCH 54/65] corrected bitmask in Full_CI_ZMQ - seemingly working shiftedbk (#68) * corrected bitmask in Full_CI_ZMQ - seemingly working shiftedbk * removed set_generators_bitmasks_as_holes_and_particles from dress_zmq * removed dress_zmq dependency to MRCC_Utils --- plugins/Full_CI_ZMQ/pt2_stoch.irp.f | 1 + plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 2 +- plugins/Full_CI_ZMQ/run_pt2_slave.irp.f | 2 +- plugins/Full_CI_ZMQ/selection.irp.f | 9 +-- plugins/Full_CI_ZMQ/selection_buffer.irp.f | 4 +- plugins/dress_zmq/EZFIO.cfg | 17 ++++++ plugins/dress_zmq/alpha_factory.irp.f | 27 ++++----- plugins/dress_zmq/dress_stoch_routines.irp.f | 2 +- plugins/dress_zmq/dress_zmq_routines.irp.f | 2 +- plugins/dress_zmq/dressing.irp.f | 2 +- plugins/shiftedbk/NEEDED_CHILDREN_MODULES | 2 +- plugins/shiftedbk/shifted_bk.irp.f | 61 +++++++++++++------- 12 files changed, 78 insertions(+), 53 deletions(-) create mode 100644 plugins/dress_zmq/EZFIO.cfg diff --git a/plugins/Full_CI_ZMQ/pt2_stoch.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch.irp.f index cd96a906..7cf27d0e 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch.irp.f @@ -19,6 +19,7 @@ subroutine run double precision :: E_CI_before, relative_error, absolute_error, eqt allocate (pt2(N_states)) + call diagonalize_CI() pt2 = 0.d0 E_CI_before = pt2_E0_denominator(1) + nuclear_repulsion diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 3d95d6b0..96c4db69 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -342,7 +342,7 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_ endif end if end do pullLoop - + E0 = sum(pt2_detail(pt2_stoch_istate,:first_det_of_teeth(tooth)-1)) prop = ((1d0 - dfloat(comb_teeth - tooth + 1) * comb_step) - pt2_cweight(first_det_of_teeth(tooth)-1)) prop = prop * pt2_weight_inv(first_det_of_teeth(tooth)) diff --git a/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f b/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f index 03b62937..88c8aacb 100644 --- a/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f +++ b/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f @@ -41,7 +41,7 @@ subroutine run_pt2_slave(thread,iproc,energy) buf%N = 0 n_tasks = 0 - call create_selection_buffer(1, 2, buf) + call create_selection_buffer(0, 0, buf) done = .False. do while (.not.done) diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index ce706d2d..2463b762 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -253,6 +253,7 @@ subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) deallocate(lbanned) end + subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf,subset) use bitmasks use selection_types @@ -289,7 +290,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d monoAdo = .true. monoBdo = .true. - + do k=1,N_int hole (k,1) = iand(psi_det_generators(k,1,i_generator), hole_mask(k,1)) @@ -598,7 +599,6 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d logical, external :: detEq - if(sp == 3) then s1 = 1 s2 = 2 @@ -616,15 +616,13 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d do p2=ib,mo_tot_num if(bannedOrb(p2, s2)) cycle if(banned(p1,p2)) cycle + if( sum(abs(mat(1:N_states, p1, p2))) == 0d0) cycle call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int) min_e_pert = 0d0 -! double precision :: hij -! call i_h_j(psi_det_generators(1,1,i_generator), det, N_int, hij) - do istate=1,N_states delta_E = E0(istate) - Hii val = mat(istate, p1, p2) + mat(istate, p1, p2) @@ -635,7 +633,6 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d e_pert = 0.5d0 * (tmp - delta_E) pt2(istate) = pt2(istate) + e_pert min_e_pert = min(e_pert,min_e_pert) -! ci(istate) = e_pert / hij end do if(min_e_pert <= buf%mini) then diff --git a/plugins/Full_CI_ZMQ/selection_buffer.irp.f b/plugins/Full_CI_ZMQ/selection_buffer.irp.f index 50c17f91..17410b7b 100644 --- a/plugins/Full_CI_ZMQ/selection_buffer.irp.f +++ b/plugins/Full_CI_ZMQ/selection_buffer.irp.f @@ -39,7 +39,7 @@ subroutine add_to_selection_buffer(b, det, val) double precision, intent(in) :: val integer :: i - if(val <= b%mini) then + if(b%N > 0 .and. val <= b%mini) then b%cur += 1 b%det(1:N_int,1:2,b%cur) = det(1:N_int,1:2) b%val(b%cur) = val @@ -119,7 +119,7 @@ subroutine sort_selection_buffer(b) integer(bit_kind), pointer :: detmp(:,:,:) integer :: i, nmwen logical, external :: detEq - if (b%cur == 0) return + if (b%N == 0 .or. b%cur == 0) return nmwen = min(b%N, b%cur) allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3))) diff --git a/plugins/dress_zmq/EZFIO.cfg b/plugins/dress_zmq/EZFIO.cfg new file mode 100644 index 00000000..52d41568 --- /dev/null +++ b/plugins/dress_zmq/EZFIO.cfg @@ -0,0 +1,17 @@ +[energy] +type: double precision +doc: Calculated energy +interface: ezfio + +[thresh_dressed_ci] +type: Threshold +doc: Threshold on the convergence of the dressed CI energy +interface: ezfio,provider,ocaml +default: 1.e-5 + +[n_it_max_dressed_ci] +type: Strictly_positive_int +doc: Maximum number of dressed CI iterations +interface: ezfio,provider,ocaml +default: 10 + diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index 39284da1..190a94ad 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -74,26 +74,19 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index monoAdo = .true. monoBdo = .true. + do k=1,N_int - !hole (k,1) = iand(psi_det_generators(k,1,i_generator), generators_bitmask(k,1,s_hole,bitmask_index)) - !hole (k,2) = iand(psi_det_generators(k,2,i_generator), generators_bitmask(k,2,s_hole,bitmask_index)) - !particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), generators_bitmask(k,1,s_part,bitmask_index)) - !particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), generators_bitmask(k,2,s_part,bitmask_index)) - hole (k,1) = iand(psi_det_generators(k,1,i_generator), full_ijkl_bitmask(k)) - hole (k,2) = iand(psi_det_generators(k,2,i_generator), full_ijkl_bitmask(k)) - particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), full_ijkl_bitmask(k)) - particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), full_ijkl_bitmask(k)) - + hole (k,1) = iand(psi_det_generators(k,1,i_generator), generators_bitmask(k,1,s_hole,bitmask_index)) + hole (k,2) = iand(psi_det_generators(k,2,i_generator), generators_bitmask(k,2,s_hole,bitmask_index)) + particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), generators_bitmask(k,1,s_part,bitmask_index)) + particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), generators_bitmask(k,2,s_part,bitmask_index)) + !hole (k,1) = iand(psi_det_generators(k,1,i_generator), full_ijkl_bitmask(k)) + !hole (k,2) = iand(psi_det_generators(k,2,i_generator), full_ijkl_bitmask(k)) + !particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), full_ijkl_bitmask(k)) + !particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), full_ijkl_bitmask(k)) + enddo - - !if(i_generator == 34) then - ! call debug_det(psi_det_generators(1,1,34), N_int) - ! call debug_det(generators_bitmask(1,1,s_part,bitmask_index), N_int) - ! call debug_det(particle, N_int) - ! print *, "dddddddddddd" - ! stop - !end if integer :: N_holes(2), N_particles(2) integer :: hole_list(N_int*bit_kind_size,2) diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 480fd415..06b5d538 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -286,7 +286,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, call wall_time(time) - if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 5) .or. total_computed == N_det_generators) then + if ((dabs(eqt) < relative_error .and. cps_N(cur_cp) >= 30) .or. total_computed == N_det_generators) then ! Termination print '(2X, F16.7, 2X, G16.3, 2X, F16.4, A20)', avg+E(istate)+E0, eqt, time-time0, '' if (zmq_abort(zmq_to_qp_run_socket) == -1) then diff --git a/plugins/dress_zmq/dress_zmq_routines.irp.f b/plugins/dress_zmq/dress_zmq_routines.irp.f index 4dc75236..bde2c6d8 100644 --- a/plugins/dress_zmq/dress_zmq_routines.irp.f +++ b/plugins/dress_zmq/dress_zmq_routines.irp.f @@ -5,7 +5,7 @@ subroutine dress_zmq() read_wf = .True. SOFT_TOUCH read_wf - call set_generators_bitmasks_as_holes_and_particles + if (.True.) then integer :: i,j do j=1,N_states diff --git a/plugins/dress_zmq/dressing.irp.f b/plugins/dress_zmq/dressing.irp.f index f835ffbf..0c15ee0b 100644 --- a/plugins/dress_zmq/dressing.irp.f +++ b/plugins/dress_zmq/dressing.irp.f @@ -86,7 +86,7 @@ BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det,2) ] ! else ! errr = 1d-4 ! end if - relative_error = 1.d-3 + relative_error = 1.d-4 call write_double(6,relative_error,"Convergence of the stochastic algorithm") call ZMQ_dress(E_CI_before, dress, del, del_s2, abs(relative_error)) diff --git a/plugins/shiftedbk/NEEDED_CHILDREN_MODULES b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES index bebf68a2..c3290687 100644 --- a/plugins/shiftedbk/NEEDED_CHILDREN_MODULES +++ b/plugins/shiftedbk/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -dress_zmq DavidsonDressed MRCC_Utils +dress_zmq DavidsonDressed diff --git a/plugins/shiftedbk/shifted_bk.irp.f b/plugins/shiftedbk/shifted_bk.irp.f index a2826aae..4c0408d8 100644 --- a/plugins/shiftedbk/shifted_bk.irp.f +++ b/plugins/shiftedbk/shifted_bk.irp.f @@ -1,17 +1,23 @@ -program mrcc_sto +program shifted_bk implicit none BEGIN_DOC ! TODO END_DOC + + call diagonalize_CI() call dress_zmq() end BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ] &BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ] +&BEGIN_PROVIDER [ double precision, a_h_i, (N_det, Nproc) ] +&BEGIN_PROVIDER [ double precision, a_s2_i, (N_det, Nproc) ] implicit none current_generator_(:) = 0 + a_h_i = 0d0 + a_s2_i = 0d0 END_PROVIDER @@ -31,40 +37,48 @@ subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minili integer(bit_kind), intent(in) :: alpha(Nint,2), det_minilist(Nint, 2, n_minilist) integer,intent(in) :: minilist(n_minilist) double precision, intent(inout) :: delta_ij_loc(Nstates,N_det,2) - double precision :: hii, hij, sij, delta_e + double precision :: haa, hij, sij double precision, external :: diag_H_mat_elem_fock integer :: i,j,k,l,m, l_sd - double precision, save :: tot = 0d0 - double precision :: de(N_states), val, tmp + double precision :: hdress, sdress + double precision :: de, a_h_psi(Nstates), c_alpha + a_h_psi = 0d0 + if(current_generator_(iproc) /= i_gen) then current_generator_(iproc) = i_gen call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int) end if - hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) - do i=1,N_states - de(i) = (E0_denominator(i) - hii) - end do - - do i=1,N_states - val = 0D0 - do l_sd=1,n_minilist - call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) - val += hij + haa = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) + + do l_sd=1,n_minilist + call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) + a_h_i(l_sd, iproc) = hij + a_s2_i(l_sd, iproc) = sij + do i=1,Nstates + a_h_psi(i) += hij * psi_coef(minilist(l_sd), i) + end do + end do + + + do i=1,Nstates + de = E0_denominator(i) - haa + if(DABS(de) < 1D-5) cycle + + c_alpha = a_h_psi(i) / de + + do l_sd=1,n_minilist + hdress = c_alpha * a_h_i(l_sd, iproc) + sdress = c_alpha * a_s2_i(l_sd, iproc) + delta_ij_loc(i, minilist(l_sd), 1) += hdress + delta_ij_loc(i, minilist(l_sd), 2) += sdress end do - val = 2d0 * val - tmp = dsqrt(de(i)**2 + val**2) - if(de(i) < 0d0) tmp = -tmp - delta_ij_loc(i, minilist(l_sd), 1) += 0.5d0 * (tmp - de(i)) ! * psi_coef(minilist(l_sd), i) end do end subroutine - - - BEGIN_PROVIDER [ logical, initialize_E0_denominator ] implicit none BEGIN_DOC @@ -72,7 +86,8 @@ BEGIN_PROVIDER [ logical, initialize_E0_denominator ] END_DOC initialize_E0_denominator = .True. END_PROVIDER - + + BEGIN_PROVIDER [ double precision, E0_denominator, (N_states) ] implicit none BEGIN_DOC @@ -88,3 +103,5 @@ BEGIN_PROVIDER [ double precision, E0_denominator, (N_states) ] E0_denominator = -huge(1.d0) endif END_PROVIDER + + From 7d18772ba484277b7a29c4d95d14ac25aa5abe2a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 20 Mar 2018 17:23:00 +0100 Subject: [PATCH 55/65] Fixed test --- tests/bats/mrcepa0.bats | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/tests/bats/mrcepa0.bats b/tests/bats/mrcepa0.bats index 9a62885e..ca463967 100644 --- a/tests/bats/mrcepa0.bats +++ b/tests/bats/mrcepa0.bats @@ -14,9 +14,11 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set determinants read_wf True ezfio set mrcepa0 lambda_type 1 ezfio set mrcepa0 n_it_max_dressed_ci 3 - qp_run $EXE $INPUT + cp -r $INPUT TMP ; qp_run $EXE TMP + ezfio set_file TMP energy="$(ezfio get mrcepa0 energy_pt2)" - eq $energy -76.2382106224545 1.e-4 + rm -rf TMP + eq $energy -76.2382119593927 1.e-4 } @test "MRCC H2O cc-pVDZ" { @@ -30,9 +32,11 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set determinants read_wf True ezfio set mrcepa0 lambda_type 0 ezfio set mrcepa0 n_it_max_dressed_ci 3 - qp_run $EXE $INPUT + cp -r $INPUT TMP ; qp_run $EXE TMP + ezfio set_file TMP energy="$(ezfio get mrcepa0 energy_pt2)" - eq $energy -76.2381754078899 1.e-4 + rm -rf TMP + eq $energy -76.2381753982902 1.e-4 } @test "MRSC2 H2O cc-pVDZ" { @@ -46,9 +50,11 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set determinants read_wf True ezfio set mrcepa0 lambda_type 1 ezfio set mrcepa0 n_it_max_dressed_ci 3 - qp_run $EXE $INPUT + cp -r $INPUT TMP ; qp_run $EXE TMP + ezfio set_file TMP energy="$(ezfio get mrcepa0 energy_pt2)" - eq $energy -76.235786994991 2.e-4 + rm -rf TMP + eq $energy -76.2357032076682 2.e-4 } @test "MRCEPA0 H2O cc-pVDZ" { @@ -62,8 +68,10 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set determinants read_wf True ezfio set mrcepa0 lambda_type 1 ezfio set mrcepa0 n_it_max_dressed_ci 3 - qp_run $EXE $INPUT + cp -r $INPUT TMP ; qp_run $EXE TMP + ezfio set_file TMP energy="$(ezfio get mrcepa0 energy_pt2)" - eq $energy -76.2411829210128 2.e-4 + rm -rf TMP + eq $energy -76.2411825032868 2.e-4 } From d23831039476097ea708f4035a1753cf2429c55d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 20 Mar 2018 17:47:33 +0100 Subject: [PATCH 56/65] Fixed test --- tests/bats/mrcepa0.bats | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/bats/mrcepa0.bats b/tests/bats/mrcepa0.bats index ca463967..4985f8f0 100644 --- a/tests/bats/mrcepa0.bats +++ b/tests/bats/mrcepa0.bats @@ -54,7 +54,7 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set_file TMP energy="$(ezfio get mrcepa0 energy_pt2)" rm -rf TMP - eq $energy -76.2357032076682 2.e-4 + eq $energy -76.2359960472962 3.e-4 } @test "MRCEPA0 H2O cc-pVDZ" { From 5a8ab847b9202ac2aa2c63e1dfeccd1cf88de161 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 23 Mar 2018 13:37:03 +0100 Subject: [PATCH 57/65] Multistate dressing OK --- ocaml/TaskServer.ml | 3 +- plugins/DavidsonDressed/diagonalize_CI.irp.f | 151 +++++++++++------- plugins/dress_zmq/dress_general.irp.f | 2 - plugins/dress_zmq/dress_stoch_routines.irp.f | 12 +- plugins/dress_zmq/dressing_vector.irp.f | 20 ++- plugins/dress_zmq/run_dress_slave.irp.f | 4 +- plugins/shiftedbk/shifted_bk.irp.f | 1 - .../diagonalization_hs2_dressed.irp.f | 54 +++++-- 8 files changed, 151 insertions(+), 96 deletions(-) diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 170e011a..ca295971 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -830,10 +830,11 @@ let run ~port = let () = if debug_env then begin - Printf.sprintf "q:%d r:%d n:%d : %s\n%!" + Printf.sprintf "q:%d r:%d n:%d c:%d : %s\n%!" (Queuing_system.number_of_queued program_state.queue) (Queuing_system.number_of_running program_state.queue) (Queuing_system.number_of_tasks program_state.queue) + (Queuing_system.number_of_clients program_state.queue) (Message.to_string message) |> debug end diff --git a/plugins/DavidsonDressed/diagonalize_CI.irp.f b/plugins/DavidsonDressed/diagonalize_CI.irp.f index 3d1c1118..2ee540e2 100644 --- a/plugins/DavidsonDressed/diagonalize_CI.irp.f +++ b/plugins/DavidsonDressed/diagonalize_CI.irp.f @@ -55,66 +55,98 @@ END_PROVIDER if (diag_algorithm == "Davidson") then - allocate (eigenvectors(size(CI_eigenvectors_dressed,1),size(CI_eigenvectors_dressed,2)),& - eigenvectors_s2(size(CI_eigenvectors_dressed,1),size(CI_eigenvectors_dressed,2)),& - eigenvalues(size(CI_electronic_energy_dressed,1))) do j=1,min(N_states,N_det) do i=1,N_det - eigenvectors(i,j) = psi_coef(i,j) + CI_eigenvectors_dressed(i,j) = psi_coef(i,j) enddo enddo - do mrcc_state=1,N_states - do j=mrcc_state,min(N_states,N_det) - do i=1,N_det - eigenvectors(i,j) = psi_coef(i,j) - enddo - enddo - call davidson_diag_HS2(psi_det,eigenvectors, eigenvectors_s2, & - size(eigenvectors,1), & - eigenvalues,N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,& - mrcc_state) - CI_eigenvectors_dressed(1:N_det,mrcc_state) = eigenvectors(1:N_det,mrcc_state) - CI_electronic_energy_dressed(mrcc_state) = eigenvalues(mrcc_state) - enddo - do k=N_states+1,N_states_diag - CI_eigenvectors_dressed(1:N_det,k) = eigenvectors(1:N_det,k) - CI_electronic_energy_dressed(k) = eigenvalues(k) - enddo + call davidson_diag_HS2(psi_det,CI_eigenvectors_dressed, CI_eigenvectors_s2_dressed,& + size(CI_eigenvectors_dressed,1), CI_electronic_energy_dressed,& + N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1) call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,& N_states_diag,size(CI_eigenvectors_dressed,1)) - deallocate (eigenvectors,eigenvalues) - else if (diag_algorithm == "Lapack") then allocate (eigenvectors(size(H_matrix_dressed,1),N_det)) allocate (eigenvalues(N_det)) - do j=1,min(N_states,N_det) - do i=1,N_det - eigenvectors(i,j) = psi_coef(i,j) - enddo - enddo - do mrcc_state=1,N_states - do j=mrcc_state,min(N_states,N_det) - do i=1,N_det - eigenvectors(i,j) = psi_coef(i,j) - enddo - enddo - call lapack_diag(eigenvalues,eigenvectors, & - H_matrix_dressed(1,1,mrcc_state),size(H_matrix_dressed,1),N_det) - CI_eigenvectors_dressed(1:N_det,mrcc_state) = eigenvectors(1:N_det,mrcc_state) - CI_electronic_energy_dressed(mrcc_state) = eigenvalues(mrcc_state) - enddo - do k=N_states+1,N_states_diag - CI_eigenvectors_dressed(1:N_det,k) = eigenvectors(1:N_det,k) - CI_electronic_energy_dressed(k) = eigenvalues(k) - enddo - call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,& - N_states_diag,size(CI_eigenvectors_dressed,1)) + H_matrix_dressed,size(H_matrix_dressed,1),N_det) + CI_electronic_energy_dressed(:) = 0.d0 + if (s2_eig) then + i_state = 0 + allocate (s2_eigvalues(N_det)) + allocate(index_good_state_array(N_det),good_state_array(N_det)) + good_state_array = .False. + call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,& + N_det,size(eigenvectors,1)) + do j=1,N_det + ! Select at least n_states states with S^2 values closed to "expected_s2" + if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then + i_state +=1 + index_good_state_array(i_state) = j + good_state_array(j) = .True. + endif + if(i_state.eq.N_states) then + exit + endif + enddo + if(i_state .ne.0)then + ! Fill the first "i_state" states that have a correct S^2 value + do j = 1, i_state + do i=1,N_det + CI_eigenvectors_dressed(i,j) = eigenvectors(i,index_good_state_array(j)) + enddo + CI_electronic_energy_dressed(j) = eigenvalues(index_good_state_array(j)) + CI_eigenvectors_s2_dressed(j) = s2_eigvalues(index_good_state_array(j)) + enddo + i_other_state = 0 + do j = 1, N_det + if(good_state_array(j))cycle + i_other_state +=1 + if(i_state+i_other_state.gt.n_states_diag)then + exit + endif + do i=1,N_det + CI_eigenvectors_dressed(i,i_state+i_other_state) = eigenvectors(i,j) + enddo + CI_electronic_energy_dressed(i_state+i_other_state) = eigenvalues(j) + CI_eigenvectors_s2_dressed(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) + enddo + else + print*,'' + print*,'!!!!!!!! WARNING !!!!!!!!!' + print*,' Within the ',N_det,'determinants selected' + print*,' and the ',N_states_diag,'states requested' + print*,' We did not find any state with S^2 values close to ',expected_s2 + print*,' We will then set the first N_states eigenvectors of the H matrix' + print*,' as the CI_eigenvectors_dressed' + print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space' + print*,'' + do j=1,min(N_states_diag,N_det) + do i=1,N_det + CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) + enddo + CI_electronic_energy_dressed(j) = eigenvalues(j) + CI_eigenvectors_s2_dressed(j) = s2_eigvalues(j) + enddo + endif + deallocate(index_good_state_array,good_state_array) + deallocate(s2_eigvalues) + else + call u_0_S2_u_0(CI_eigenvectors_s2_dressed,eigenvectors,N_det,psi_det,N_int,& + min(N_det,N_states_diag),size(eigenvectors,1)) + ! Select the "N_states_diag" states of lowest energy + do j=1,min(N_det,N_states_diag) + do i=1,N_det + CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) + enddo + CI_electronic_energy_dressed(j) = eigenvalues(j) + enddo + endif deallocate(eigenvectors,eigenvalues) endif @@ -137,24 +169,23 @@ end -BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ] +BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det) ] implicit none BEGIN_DOC ! Dressed H with Delta_ij END_DOC - integer :: i, j, ii,jj, dressing_state - do dressing_state = 1,N_states - do j=1,N_det - do i=1,N_det - h_matrix_dressed(i,j,dressing_state) = h_matrix_all_dets(i,j) - enddo - enddo - i = dressed_column_idx(dressing_state) - do j = 1, N_det - h_matrix_dressed(i,j,dressing_state) += dressing_column_h(j,dressing_state) - h_matrix_dressed(j,i,dressing_state) += dressing_column_h(j,dressing_state) - enddo - h_matrix_dressed(i,i,dressing_state) -= dressing_column_h(i,dressing_state) - enddo + integer :: i, j, k + + h_matrix_dressed(1:N_det,1:N_det) = h_matrix_all_dets(1:N_det,1:N_det) + do k=1,N_states + do j=1,N_det + do i=1,N_det + h_matrix_dressed(i,j) = h_matrix_dressed(i,j) + & + 0.5d0 * (dressing_column_h(i,k) * psi_coef(j,k) + & + dressing_column_h(j,k) * psi_coef(i,k)) + enddo + enddo + enddo + END_PROVIDER diff --git a/plugins/dress_zmq/dress_general.irp.f b/plugins/dress_zmq/dress_general.irp.f index 0bf7e715..068d811e 100644 --- a/plugins/dress_zmq/dress_general.irp.f +++ b/plugins/dress_zmq/dress_general.irp.f @@ -1,5 +1,3 @@ - - subroutine run_dressing(N_st,energy) implicit none diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 06b5d538..f1406b7b 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -4,7 +4,7 @@ BEGIN_PROVIDER [ integer, fragment_first ] END_PROVIDER -subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) +subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error) use f77_zmq implicit none @@ -15,9 +15,11 @@ subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) integer, external :: omp_get_thread_num double precision, intent(in) :: E(N_states), relative_error double precision, intent(out) :: dress(N_states) - double precision, intent(out) :: delta(N_states, N_det) - double precision, intent(out) :: delta_s2(N_states, N_det) + double precision, intent(out) :: delta_out(N_states, N_det) + double precision, intent(out) :: delta_s2_out(N_states, N_det) + double precision, allocatable :: delta(:,:) + double precision, allocatable :: delta_s2(:,:) integer :: i, j, k, Ncp @@ -27,6 +29,7 @@ subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) double precision :: state_average_weight_save(N_states) + allocate(delta(N_states,N_det), delta_s2(N_det,N_states)) state_average_weight_save(:) = state_average_weight(:) do dress_stoch_istate=1,N_states SOFT_TOUCH dress_stoch_istate @@ -108,6 +111,8 @@ subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) call dress_slave_inproc(i) endif !$OMP END PARALLEL + delta_out(dress_stoch_istate,1:N_det) = delta(dress_stoch_istate,1:N_det) + delta_s2_out(dress_stoch_istate,1:N_det) = delta_s2_out(dress_stoch_istate,1:N_det) call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'dress') print *, '========== ================= ================= =================' @@ -115,6 +120,7 @@ subroutine ZMQ_dress(E, dress, delta, delta_s2, relative_error) FREE dress_stoch_istate state_average_weight(:) = state_average_weight_save(:) TOUCH state_average_weight + deallocate(delta,delta_s2) end subroutine diff --git a/plugins/dress_zmq/dressing_vector.irp.f b/plugins/dress_zmq/dressing_vector.irp.f index 494e7c4b..5a8fee3b 100644 --- a/plugins/dress_zmq/dressing_vector.irp.f +++ b/plugins/dress_zmq/dressing_vector.irp.f @@ -3,7 +3,7 @@ &BEGIN_PROVIDER [ double precision, dressing_column_s, (N_det,N_states) ] implicit none BEGIN_DOC - ! Null dressing vectors + ! \Delta_{state-specific}. \Psi END_DOC integer :: i,ii,k,j, l @@ -14,18 +14,16 @@ dressing_column_s(:,:) = 0.d0 do k=1,N_states - l = dressed_column_idx(k) - f = 1.d0/psi_coef(l,k) do j = 1, n_det - dressing_column_h(j,k) = delta_ij(k,j,1) * f - dressing_column_s(j,k) = delta_ij(k,j,2) * f + dressing_column_h(j,k) = delta_ij(k,j,1) + dressing_column_s(j,k) = delta_ij(k,j,2) enddo - tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) & - - dressing_column_h(l,k) * psi_coef(l,k) - dressing_column_h(l,k) -= tmp * f - tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) & - - dressing_column_s(l,k) * psi_coef(l,k) - dressing_column_s(l,k) -= tmp * f +! tmp = u_dot_v(dressing_column_h(1,k), psi_coef(1,k), N_det) & +! - dressing_column_h(l,k) * psi_coef(l,k) +! dressing_column_h(l,k) -= tmp * f +! tmp = u_dot_v(dressing_column_s(1,k), psi_coef(1,k), N_det) & +! - dressing_column_s(l,k) * psi_coef(l,k) +! dressing_column_s(l,k) -= tmp * f enddo END_PROVIDER diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index b0896c00..0311d2ed 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -62,9 +62,9 @@ subroutine run_dress_slave(thread,iproc,energy) exit end if end do - call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) call end_zmq_push_socket(zmq_socket_push,thread) + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) end subroutine diff --git a/plugins/shiftedbk/shifted_bk.irp.f b/plugins/shiftedbk/shifted_bk.irp.f index 4c0408d8..d2ab57ad 100644 --- a/plugins/shiftedbk/shifted_bk.irp.f +++ b/plugins/shiftedbk/shifted_bk.irp.f @@ -1,4 +1,3 @@ - program shifted_bk implicit none BEGIN_DOC diff --git a/src/Davidson/diagonalization_hs2_dressed.irp.f b/src/Davidson/diagonalization_hs2_dressed.irp.f index 4e853f32..59e9c9fe 100644 --- a/src/Davidson/diagonalization_hs2_dressed.irp.f +++ b/src/Davidson/diagonalization_hs2_dressed.irp.f @@ -38,7 +38,7 @@ subroutine davidson_diag_hs2(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_d double precision, allocatable :: H_jj(:), S2_jj(:) double precision, external :: diag_H_mat_elem, diag_S_mat_elem - integer :: i + integer :: i,k ASSERT (N_st > 0) ASSERT (sze > 0) ASSERT (Nint > 0) @@ -58,7 +58,11 @@ subroutine davidson_diag_hs2(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_d !$OMP END PARALLEL if (dressing_state > 0) then - H_jj(dressed_column_idx(dressing_state)) += dressing_column_h(dressed_column_idx(dressing_state),dressing_state) + do k=1,N_st + do i=1,sze + H_jj(i) += u_in(i,k) * dressing_column_h(i,k) + enddo + enddo endif call davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_out,energies,dim_in,sze,N_st,N_st_diag,Nint,dressing_state) @@ -150,17 +154,17 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ do i=1,N_st write_buffer = trim(write_buffer)//' ================ =========== ===========' enddo - write(6,'(A)') write_buffer(1:6+41*N_states) + write(6,'(A)') write_buffer(1:6+41*N_st) write_buffer = 'Iter' do i=1,N_st write_buffer = trim(write_buffer)//' Energy S^2 Residual ' enddo - write(6,'(A)') write_buffer(1:6+41*N_states) + write(6,'(A)') write_buffer(1:6+41*N_st) write_buffer = '=====' do i=1,N_st write_buffer = trim(write_buffer)//' ================ =========== ===========' enddo - write(6,'(A)') write_buffer(1:6+41*N_states) + write(6,'(A)') write_buffer(1:6+41*N_st) allocate( & @@ -242,17 +246,35 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ if (dressing_state > 0) then - l = dressed_column_idx(dressing_state) - do istate=1,N_st_diag - do i=1,sze - W(i,shift+istate) += dressing_column_h(i,dressing_state) * U(l,shift+istate) - S(i,shift+istate) += dressing_column_s(i,dressing_state) * U(l,shift+istate) - W(l,shift+istate) += dressing_column_h(i,dressing_state) * U(i,shift+istate) - S(l,shift+istate) += dressing_column_s(i,dressing_state) * U(i,shift+istate) - enddo - W(l,shift+istate) -= dressing_column_h(l,dressing_state) * U(l,shift+istate) - S(l,shift+istate) -= dressing_column_s(l,dressing_state) * U(l,shift+istate) - enddo + call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & + psi_coef, size(psi_coef,1), & + U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) + + call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, & + dressing_column_h, size(dressing_column_h,1), s_tmp, size(s_tmp,1), & + 1.d0, W(1,shift+1), size(W,1)) + + call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, & + dressing_column_s, size(dressing_column_s,1), s_tmp, size(s_tmp,1), & + 1.d0, S(1,shift+1), size(S,1)) + + + call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & + dressing_column_h, size(dressing_column_h,1), & + U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) + + call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, & + psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & + 1.d0, W(1,shift+1), size(W,1)) + + call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & + dressing_column_s, size(dressing_column_s,1), & + U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) + + call dgemm('N','N', sze, N_st_diag, N_st, 0.5d0, & + psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & + 1.d0, S(1,shift+1), size(S,1)) + endif ! Compute h_kl = = From af1c600a53f904b5772274d512375059b3fcc8c0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 26 Mar 2018 12:06:18 +0200 Subject: [PATCH 58/65] Added shifted_bk_slave --- plugins/shiftedbk/shifted_bk.irp.f | 97 --------------------- plugins/shiftedbk/shifted_bk_routines.irp.f | 95 ++++++++++++++++++++ plugins/shiftedbk/shifted_bk_slave.irp.f | 8 ++ 3 files changed, 103 insertions(+), 97 deletions(-) create mode 100644 plugins/shiftedbk/shifted_bk_routines.irp.f create mode 100644 plugins/shiftedbk/shifted_bk_slave.irp.f diff --git a/plugins/shiftedbk/shifted_bk.irp.f b/plugins/shiftedbk/shifted_bk.irp.f index d2ab57ad..b7a2a1ce 100644 --- a/plugins/shiftedbk/shifted_bk.irp.f +++ b/plugins/shiftedbk/shifted_bk.irp.f @@ -7,100 +7,3 @@ program shifted_bk call diagonalize_CI() call dress_zmq() end - - - BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ] -&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ] -&BEGIN_PROVIDER [ double precision, a_h_i, (N_det, Nproc) ] -&BEGIN_PROVIDER [ double precision, a_s2_i, (N_det, Nproc) ] - implicit none - current_generator_(:) = 0 - a_h_i = 0d0 - a_s2_i = 0d0 - END_PROVIDER - - - -subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) - use bitmasks - implicit none - BEGIN_DOC - !delta_ij_loc(:,:,1) : dressing column for H - !delta_ij_loc(:,:,2) : dressing column for S2 - !i_gen : generator index in psi_det_generators - !minilist : indices of determinants connected to alpha ( in psi_det_sorted ) - !n_minilist : size of minilist - !alpha : alpha determinant - END_DOC - integer, intent(in) :: Nint, Ndet, Nstates, n_minilist, iproc, i_gen - integer(bit_kind), intent(in) :: alpha(Nint,2), det_minilist(Nint, 2, n_minilist) - integer,intent(in) :: minilist(n_minilist) - double precision, intent(inout) :: delta_ij_loc(Nstates,N_det,2) - double precision :: haa, hij, sij - double precision, external :: diag_H_mat_elem_fock - integer :: i,j,k,l,m, l_sd - double precision :: hdress, sdress - double precision :: de, a_h_psi(Nstates), c_alpha - - - a_h_psi = 0d0 - - if(current_generator_(iproc) /= i_gen) then - current_generator_(iproc) = i_gen - call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int) - end if - - haa = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) - - do l_sd=1,n_minilist - call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) - a_h_i(l_sd, iproc) = hij - a_s2_i(l_sd, iproc) = sij - do i=1,Nstates - a_h_psi(i) += hij * psi_coef(minilist(l_sd), i) - end do - end do - - - do i=1,Nstates - de = E0_denominator(i) - haa - if(DABS(de) < 1D-5) cycle - - c_alpha = a_h_psi(i) / de - - do l_sd=1,n_minilist - hdress = c_alpha * a_h_i(l_sd, iproc) - sdress = c_alpha * a_s2_i(l_sd, iproc) - delta_ij_loc(i, minilist(l_sd), 1) += hdress - delta_ij_loc(i, minilist(l_sd), 2) += sdress - end do - end do -end subroutine - - -BEGIN_PROVIDER [ logical, initialize_E0_denominator ] - implicit none - BEGIN_DOC - ! If true, initialize pt2_E0_denominator - END_DOC - initialize_E0_denominator = .True. -END_PROVIDER - - -BEGIN_PROVIDER [ double precision, E0_denominator, (N_states) ] - implicit none - BEGIN_DOC - ! E0 in the denominator of the PT2 - END_DOC - if (initialize_E0_denominator) then - E0_denominator(1:N_states) = psi_energy(1:N_states) - ! call ezfio_get_full_ci_zmq_energy(pt2_E0_denominator(1)) - ! pt2_E0_denominator(1) -= nuclear_repulsion - ! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion - ! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) - else - E0_denominator = -huge(1.d0) - endif -END_PROVIDER - - diff --git a/plugins/shiftedbk/shifted_bk_routines.irp.f b/plugins/shiftedbk/shifted_bk_routines.irp.f new file mode 100644 index 00000000..498e6e42 --- /dev/null +++ b/plugins/shiftedbk/shifted_bk_routines.irp.f @@ -0,0 +1,95 @@ + BEGIN_PROVIDER [ double precision, fock_diag_tmp_, (2,mo_tot_num+1,Nproc) ] +&BEGIN_PROVIDER [ integer, current_generator_, (Nproc) ] +&BEGIN_PROVIDER [ double precision, a_h_i, (N_det, Nproc) ] +&BEGIN_PROVIDER [ double precision, a_s2_i, (N_det, Nproc) ] + implicit none + current_generator_(:) = 0 + a_h_i = 0d0 + a_s2_i = 0d0 + END_PROVIDER + + + +subroutine dress_with_alpha_buffer(Nstates,Ndet,Nint,delta_ij_loc, i_gen, minilist, det_minilist, n_minilist, alpha, iproc) + use bitmasks + implicit none + BEGIN_DOC + !delta_ij_loc(:,:,1) : dressing column for H + !delta_ij_loc(:,:,2) : dressing column for S2 + !i_gen : generator index in psi_det_generators + !minilist : indices of determinants connected to alpha ( in psi_det_sorted ) + !n_minilist : size of minilist + !alpha : alpha determinant + END_DOC + integer, intent(in) :: Nint, Ndet, Nstates, n_minilist, iproc, i_gen + integer(bit_kind), intent(in) :: alpha(Nint,2), det_minilist(Nint, 2, n_minilist) + integer,intent(in) :: minilist(n_minilist) + double precision, intent(inout) :: delta_ij_loc(Nstates,N_det,2) + double precision :: haa, hij, sij + double precision, external :: diag_H_mat_elem_fock + integer :: i,j,k,l,m, l_sd + double precision :: hdress, sdress + double precision :: de, a_h_psi(Nstates), c_alpha + + + a_h_psi = 0d0 + + if(current_generator_(iproc) /= i_gen) then + current_generator_(iproc) = i_gen + call build_fock_tmp(fock_diag_tmp_(1,1,iproc),psi_det_generators(1,1,i_gen),N_int) + end if + + haa = diag_H_mat_elem_fock(psi_det_generators(1,1,i_gen),alpha,fock_diag_tmp_(1,1,iproc),N_int) + + do l_sd=1,n_minilist + call i_h_j_s2(alpha,det_minilist(1,1,l_sd),N_int,hij, sij) + a_h_i(l_sd, iproc) = hij + a_s2_i(l_sd, iproc) = sij + do i=1,Nstates + a_h_psi(i) += hij * psi_coef(minilist(l_sd), i) + end do + end do + + + do i=1,Nstates + de = E0_denominator(i) - haa + if(DABS(de) < 1D-5) cycle + + c_alpha = a_h_psi(i) / de + + do l_sd=1,n_minilist + hdress = c_alpha * a_h_i(l_sd, iproc) + sdress = c_alpha * a_s2_i(l_sd, iproc) + delta_ij_loc(i, minilist(l_sd), 1) += hdress + delta_ij_loc(i, minilist(l_sd), 2) += sdress + end do + end do +end subroutine + + +BEGIN_PROVIDER [ logical, initialize_E0_denominator ] + implicit none + BEGIN_DOC + ! If true, initialize pt2_E0_denominator + END_DOC + initialize_E0_denominator = .True. +END_PROVIDER + + +BEGIN_PROVIDER [ double precision, E0_denominator, (N_states) ] + implicit none + BEGIN_DOC + ! E0 in the denominator of the PT2 + END_DOC + if (initialize_E0_denominator) then + E0_denominator(1:N_states) = psi_energy(1:N_states) + ! call ezfio_get_full_ci_zmq_energy(pt2_E0_denominator(1)) + ! pt2_E0_denominator(1) -= nuclear_repulsion + ! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion + ! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) + else + E0_denominator = -huge(1.d0) + endif +END_PROVIDER + + diff --git a/plugins/shiftedbk/shifted_bk_slave.irp.f b/plugins/shiftedbk/shifted_bk_slave.irp.f new file mode 100644 index 00000000..27787cf2 --- /dev/null +++ b/plugins/shiftedbk/shifted_bk_slave.irp.f @@ -0,0 +1,8 @@ +program bk_slave + implicit none + BEGIN_DOC +! Helper subroutine to compute the dress in distributed mode. + END_DOC + call dress_slave +end + From 4cbe7d33a2d4adbd3a0db61ea2b7feb0015f5b12 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 29 Mar 2018 10:31:35 +0200 Subject: [PATCH 59/65] debug --- src/ZMQ/utils.irp.f | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index 804df09f..fac7470c 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -785,13 +785,14 @@ integer function zmq_abort(zmq_to_qp_run_socket) sze = len(trim(message)) rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0) if (rc /= sze) then + print *, 'zmq_abort: rc /= sze', rc, sze zmq_abort = -1 return endif rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) if (trim(message(1:rc)) /= 'ok') then - print *, 'zmq_abort: '//trim(message(1:rc)) + print *, 'zmq_abort: ', rc, ':', trim(message(1:rc)) zmq_abort = -1 return endif From 7411dd28917ab1faddfb2bbd2b9f595714ea8914 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 9 Apr 2018 18:34:45 +0200 Subject: [PATCH 60/65] analyze_wf --- plugins/analyze_wf/occupation.irp.f | 8 ++++++-- plugins/dress_zmq/dress_stoch_routines.irp.f | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/plugins/analyze_wf/occupation.irp.f b/plugins/analyze_wf/occupation.irp.f index c208cda3..0962247e 100644 --- a/plugins/analyze_wf/occupation.irp.f +++ b/plugins/analyze_wf/occupation.irp.f @@ -8,13 +8,17 @@ subroutine get_occupation_from_dets(istate,occupation) integer :: i,j, ispin integer :: list(N_int*bit_kind_size,2) integer :: n_elements(2) - double precision :: c + double precision :: c, norm_2 ASSERT (istate > 0) ASSERT (istate <= N_states) occupation = 0.d0 + double precision, external :: u_dot_u + + norm_2 = 1.d0/u_dot_u(psi_coef(1,istate),N_det) + do i=1,N_det - c = psi_coef(i,istate)*psi_coef(i,istate) + c = psi_coef(i,istate)*psi_coef(i,istate)*norm_2 call bitstring_to_list_ab(psi_det(1,1,i), list, n_elements, N_int) do ispin=1,2 do j=1,n_elements(ispin) diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index f1406b7b..6bee7256 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -369,7 +369,7 @@ end function ! gen_per_cp : number of generators per checkpoint END_DOC comb_teeth = 64 - N_cps_max = 64 + N_cps_max = 256 gen_per_cp = (N_det_generators / N_cps_max) + 1 END_PROVIDER From f3a79c231678f5f4b8ff5a20837d6540a75f6afe Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 12 Apr 2018 15:29:44 +0200 Subject: [PATCH 61/65] Barycentric energy --- ocaml/myocamlbuild.ml | 13 +++++++++ plugins/Full_CI_ZMQ/energy.irp.f | 5 ++-- plugins/shiftedbk/shifted_bk_routines.irp.f | 6 ++-- src/Determinants/energy.irp.f | 31 +++++++++++++++++++++ 4 files changed, 50 insertions(+), 5 deletions(-) create mode 100644 ocaml/myocamlbuild.ml create mode 100644 src/Determinants/energy.irp.f diff --git a/ocaml/myocamlbuild.ml b/ocaml/myocamlbuild.ml new file mode 100644 index 00000000..2980af57 --- /dev/null +++ b/ocaml/myocamlbuild.ml @@ -0,0 +1,13 @@ +open Ocamlbuild_plugin;; +open Command;; + +dispatch begin function + | Before_rules -> + begin + end + | After_rules -> + begin + flag ["ocaml";"compile";"native";"gprof"] (S [ A "-p"]); + end + | _ -> () +end diff --git a/plugins/Full_CI_ZMQ/energy.irp.f b/plugins/Full_CI_ZMQ/energy.irp.f index 281f8eea..a8361b2d 100644 --- a/plugins/Full_CI_ZMQ/energy.irp.f +++ b/plugins/Full_CI_ZMQ/energy.irp.f @@ -12,14 +12,15 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ] ! E0 in the denominator of the PT2 END_DOC if (initialize_pt2_E0_denominator) then - pt2_E0_denominator(1:N_states) = psi_energy(1:N_states) + pt2_E0_denominator(1:N_states) = psi_energy(1:N_states) ! call ezfio_get_full_ci_zmq_energy(pt2_E0_denominator(1)) ! pt2_E0_denominator(1) -= nuclear_repulsion ! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion -! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) +! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) call write_double(6,pt2_E0_denominator(1)+nuclear_repulsion, 'PT2 Energy denominator') else pt2_E0_denominator = -huge(1.d0) endif END_PROVIDER + diff --git a/plugins/shiftedbk/shifted_bk_routines.irp.f b/plugins/shiftedbk/shifted_bk_routines.irp.f index 498e6e42..aae25315 100644 --- a/plugins/shiftedbk/shifted_bk_routines.irp.f +++ b/plugins/shiftedbk/shifted_bk_routines.irp.f @@ -84,9 +84,9 @@ BEGIN_PROVIDER [ double precision, E0_denominator, (N_states) ] if (initialize_E0_denominator) then E0_denominator(1:N_states) = psi_energy(1:N_states) ! call ezfio_get_full_ci_zmq_energy(pt2_E0_denominator(1)) - ! pt2_E0_denominator(1) -= nuclear_repulsion - ! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion - ! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) + ! E0_denominator(1) -= nuclear_repulsion + ! E0_denominator(1:N_states) = HF_energy - nuclear_repulsion + ! E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) else E0_denominator = -huge(1.d0) endif diff --git a/src/Determinants/energy.irp.f b/src/Determinants/energy.irp.f new file mode 100644 index 00000000..5a49afc2 --- /dev/null +++ b/src/Determinants/energy.irp.f @@ -0,0 +1,31 @@ +BEGIN_PROVIDER [ double precision, diagonal_H_matrix_on_psi_det, (N_det) ] + implicit none + BEGIN_DOC + ! Diagonal of the Hamiltonian ordered as psi_det + END_DOC + double precision, external :: diag_h_mat_elem + integer :: i + + do i=1,N_det + diagonal_H_matrix_on_psi_det(i) = diag_h_mat_elem(psi_det(1,1,i),N_int) + enddo + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, barycentric_electronic_energy, (N_states) ] + implicit none + BEGIN_DOC + ! TODO : ASCII Elephant + END_DOC + integer :: istate,i + + barycentric_electronic_energy(:) = 0.d0 + + do istate=1,N_states + do i=1,N_det + barycentric_electronic_energy(istate) += psi_coef(i,istate)*psi_coef(i,istate)*diagonal_H_matrix_on_psi_det(i) + enddo + enddo + +END_PROVIDER + From 85bb6ac5f41b060c4638bd6b45ca7c4d39347807 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 12 Apr 2018 15:45:28 +0200 Subject: [PATCH 62/65] Added barycentric PT --- ocaml/qptypes_generator.ml | 20 +++++++++++++++++++ plugins/Full_CI_ZMQ/energy.irp.f | 10 ++++++++-- plugins/Perturbation/EZFIO.cfg | 5 +++++ plugins/shiftedbk/EZFIO.cfg | 22 +++++++++++++++++++++ plugins/shiftedbk/shifted_bk_routines.irp.f | 13 +++++++----- 5 files changed, 63 insertions(+), 7 deletions(-) create mode 100644 plugins/shiftedbk/EZFIO.cfg diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index aa6bd533..d76120b8 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -214,6 +214,26 @@ end = struct | _ -> raise (Invalid_argument (\"Wrong IO type : \"^s)) end + +module Perturbation : sig + type t [@@deriving sexp] + val to_string : t -> string + val of_string : string -> t +end = struct + type t = + | EN + | Barycentric + [@@deriving sexp] + + let to_string = function + | EN -> \"EN\" + | Barycentric -> \"Barycentric\" + let of_string s = + match (String.lowercase_ascii s) with + | \"en\" -> EN + | \"barycentric\" -> Barycentric + | _ -> raise (Invalid_argument (\"Wrong Perturbation type : \"^s)) +end " diff --git a/plugins/Full_CI_ZMQ/energy.irp.f b/plugins/Full_CI_ZMQ/energy.irp.f index a8361b2d..72895a1d 100644 --- a/plugins/Full_CI_ZMQ/energy.irp.f +++ b/plugins/Full_CI_ZMQ/energy.irp.f @@ -12,11 +12,17 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ] ! E0 in the denominator of the PT2 END_DOC if (initialize_pt2_E0_denominator) then - pt2_E0_denominator(1:N_states) = psi_energy(1:N_states) + if (h0_type == "EN") then + pt2_E0_denominator(1:N_states) = psi_energy(1:N_states) + else if (h0_type == "Barycentric") then + pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) + else + print *, h0_type, ' not implemented' + stop + endif ! call ezfio_get_full_ci_zmq_energy(pt2_E0_denominator(1)) ! pt2_E0_denominator(1) -= nuclear_repulsion ! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion -! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) call write_double(6,pt2_E0_denominator(1)+nuclear_repulsion, 'PT2 Energy denominator') else pt2_E0_denominator = -huge(1.d0) diff --git a/plugins/Perturbation/EZFIO.cfg b/plugins/Perturbation/EZFIO.cfg index 7120e4a6..8c56b03a 100644 --- a/plugins/Perturbation/EZFIO.cfg +++ b/plugins/Perturbation/EZFIO.cfg @@ -62,4 +62,9 @@ doc: Thresholds on selectors (fraction of the norm) for final PT2 calculation interface: ezfio,provider,ocaml default: 1. +[h0_type] +type: Perturbation +doc: Type of zeroth-order Hamiltonian [ EN | Barycentric ] +interface: ezfio,provider,ocaml +default: EN diff --git a/plugins/shiftedbk/EZFIO.cfg b/plugins/shiftedbk/EZFIO.cfg new file mode 100644 index 00000000..c8dbb19e --- /dev/null +++ b/plugins/shiftedbk/EZFIO.cfg @@ -0,0 +1,22 @@ +[energy] +type: double precision +doc: Calculated energy +interface: ezfio + +[thresh_dressed_ci] +type: Threshold +doc: Threshold on the convergence of the dressed CI energy +interface: ezfio,provider,ocaml +default: 1.e-5 + +[n_it_max_dressed_ci] +type: Strictly_positive_int +doc: Maximum number of dressed CI iterations +interface: ezfio,provider,ocaml +default: 10 + +[h0_type] +type: Perturbation +doc: Type of zeroth-order Hamiltonian [ EN | Barycentric ] +interface: ezfio,provider,ocaml +default: EN diff --git a/plugins/shiftedbk/shifted_bk_routines.irp.f b/plugins/shiftedbk/shifted_bk_routines.irp.f index aae25315..e88d153c 100644 --- a/plugins/shiftedbk/shifted_bk_routines.irp.f +++ b/plugins/shiftedbk/shifted_bk_routines.irp.f @@ -82,11 +82,14 @@ BEGIN_PROVIDER [ double precision, E0_denominator, (N_states) ] ! E0 in the denominator of the PT2 END_DOC if (initialize_E0_denominator) then - E0_denominator(1:N_states) = psi_energy(1:N_states) - ! call ezfio_get_full_ci_zmq_energy(pt2_E0_denominator(1)) - ! E0_denominator(1) -= nuclear_repulsion - ! E0_denominator(1:N_states) = HF_energy - nuclear_repulsion - ! E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) + if (h0_type == "EN") then + E0_denominator(1:N_states) = psi_energy(1:N_states) + else if (h0_type == "Barycentric") then + E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) + else + print *, h0_type, ' not implemented' + stop + endif else E0_denominator = -huge(1.d0) endif From 600c82c021aa606c22ced1cd8602a44e53e28790 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 30 Apr 2018 18:43:13 +0200 Subject: [PATCH 63/65] python2 --- README.md | 4 ++-- configure => configure.py | 2 +- scripts/compilation/cache_compile.py | 2 +- scripts/compilation/qp_create_ninja.py | 2 +- scripts/compilation/read_compilation_cfg.py | 2 +- scripts/entanglement.py | 2 +- scripts/ezfio_interface/ei_handler.py | 2 +- scripts/ezfio_interface/ezfio_generate_ocaml.py | 2 +- scripts/ezfio_interface/ezfio_generate_provider.py | 2 +- scripts/ezfio_interface/qp_convert_output_to_ezfio.py | 2 +- scripts/generate_h_apply.py | 2 +- scripts/module/module_handler.py | 2 +- scripts/module/qp_module.py | 2 +- scripts/module/qp_update_readme.py | 2 +- scripts/perturbation.py | 2 +- scripts/pseudo/elts_num_ele.py | 2 +- scripts/pseudo/put_pseudo_in_ezfio.py | 2 +- scripts/qp_bitmasks.py | 2 +- scripts/qp_set_frozen_core.py | 2 +- scripts/save_current_mos.sh | 2 +- scripts/utility/get_groups.py | 2 +- scripts/utility/is_master_repository.py | 2 +- scripts/utility/qp_path.py | 2 +- 23 files changed, 24 insertions(+), 24 deletions(-) rename configure => configure.py (99%) diff --git a/README.md b/README.md index 52f949c3..6c27753d 100644 --- a/README.md +++ b/README.md @@ -41,9 +41,9 @@ Demo ### 1) Configure - $ ./configure + $ ./configure.py -For example you can type `./configure config/gfortran.cfg` +For example you can type `./configure.py config/gfortran.cfg` This command has two purposes : diff --git a/configure b/configure.py similarity index 99% rename from configure rename to configure.py index 544770e1..19c2c2fe 100755 --- a/configure +++ b/configure.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- """configure diff --git a/scripts/compilation/cache_compile.py b/scripts/compilation/cache_compile.py index 37f9b14b..d95adbda 100755 --- a/scripts/compilation/cache_compile.py +++ b/scripts/compilation/cache_compile.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 """ Save the .o from a .f90 and is the .o is asked a second time, retur it diff --git a/scripts/compilation/qp_create_ninja.py b/scripts/compilation/qp_create_ninja.py index b3e40a14..f1164627 100755 --- a/scripts/compilation/qp_create_ninja.py +++ b/scripts/compilation/qp_create_ninja.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- """ Usage: qp_create_ninja.py create (--development | --production) diff --git a/scripts/compilation/read_compilation_cfg.py b/scripts/compilation/read_compilation_cfg.py index 8145527c..a452e31f 100755 --- a/scripts/compilation/read_compilation_cfg.py +++ b/scripts/compilation/read_compilation_cfg.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- import os diff --git a/scripts/entanglement.py b/scripts/entanglement.py index c55cc98e..c61bae8f 100755 --- a/scripts/entanglement.py +++ b/scripts/entanglement.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- import sys import matplotlib.pyplot as plt diff --git a/scripts/ezfio_interface/ei_handler.py b/scripts/ezfio_interface/ei_handler.py index 8d154fc2..4137bb0e 100755 --- a/scripts/ezfio_interface/ei_handler.py +++ b/scripts/ezfio_interface/ei_handler.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- """ Welcome to the ei_handler. diff --git a/scripts/ezfio_interface/ezfio_generate_ocaml.py b/scripts/ezfio_interface/ezfio_generate_ocaml.py index 244f67a3..deea0463 100755 --- a/scripts/ezfio_interface/ezfio_generate_ocaml.py +++ b/scripts/ezfio_interface/ezfio_generate_ocaml.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 """ This program generates all the OCaml templates needed by qp_edit diff --git a/scripts/ezfio_interface/ezfio_generate_provider.py b/scripts/ezfio_interface/ezfio_generate_provider.py index 24b10e0e..4a8e7ec4 100755 --- a/scripts/ezfio_interface/ezfio_generate_provider.py +++ b/scripts/ezfio_interface/ezfio_generate_provider.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 __author__ = "Applencourt PEP8" __date__ = "jeudi 26 mars 2015, 12:49:35 (UTC+0100)" diff --git a/scripts/ezfio_interface/qp_convert_output_to_ezfio.py b/scripts/ezfio_interface/qp_convert_output_to_ezfio.py index 7f4f30be..6b415dd7 100755 --- a/scripts/ezfio_interface/qp_convert_output_to_ezfio.py +++ b/scripts/ezfio_interface/qp_convert_output_to_ezfio.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 """ convert output of gamess/GAU$$IAN to ezfio diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 3b5d96c2..a100dd88 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 import os diff --git a/scripts/module/module_handler.py b/scripts/module/module_handler.py index e6a13441..c142cdb4 100755 --- a/scripts/module/module_handler.py +++ b/scripts/module/module_handler.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- """ Module utilitary diff --git a/scripts/module/qp_module.py b/scripts/module/qp_module.py index adeb3a46..e6baeee4 100755 --- a/scripts/module/qp_module.py +++ b/scripts/module/qp_module.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- """ Usage: diff --git a/scripts/module/qp_update_readme.py b/scripts/module/qp_update_readme.py index cc42e49e..b76030e9 100755 --- a/scripts/module/qp_update_readme.py +++ b/scripts/module/qp_update_readme.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- """ Updates the README.rst of a module diff --git a/scripts/perturbation.py b/scripts/perturbation.py index fab02b25..1639bd00 100755 --- a/scripts/perturbation.py +++ b/scripts/perturbation.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 import os diff --git a/scripts/pseudo/elts_num_ele.py b/scripts/pseudo/elts_num_ele.py index f0aa3179..243d3474 100644 --- a/scripts/pseudo/elts_num_ele.py +++ b/scripts/pseudo/elts_num_ele.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 import os diff --git a/scripts/pseudo/put_pseudo_in_ezfio.py b/scripts/pseudo/put_pseudo_in_ezfio.py index 9a62a3db..957e59da 100755 --- a/scripts/pseudo/put_pseudo_in_ezfio.py +++ b/scripts/pseudo/put_pseudo_in_ezfio.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- """ Create the pseudo potential for a given atom diff --git a/scripts/qp_bitmasks.py b/scripts/qp_bitmasks.py index 3787ccb0..ff97edd3 100644 --- a/scripts/qp_bitmasks.py +++ b/scripts/qp_bitmasks.py @@ -1,4 +1,4 @@ -#! /usr/bin/env python +#! /usr/bin/env python2 BIT_KIND_SIZE=64 diff --git a/scripts/qp_set_frozen_core.py b/scripts/qp_set_frozen_core.py index 2bfd89e5..51915170 100755 --- a/scripts/qp_set_frozen_core.py +++ b/scripts/qp_set_frozen_core.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 import os import sys diff --git a/scripts/save_current_mos.sh b/scripts/save_current_mos.sh index f9d7806f..3b546ca0 100755 --- a/scripts/save_current_mos.sh +++ b/scripts/save_current_mos.sh @@ -24,7 +24,7 @@ if [[ ! -f "${EZFIO}/mo_basis/mo_label" ]] then LABEL='no_label' else - LABEL=$(head -1 "${EZFIO}/mo_basis/mo_label") + LABEL=$(head -1 "${EZFIO}/mo_basis/mo_label" | xargs) #xargs trims the result fi DESTINATION="save/mo_basis/${LABEL}" diff --git a/scripts/utility/get_groups.py b/scripts/utility/get_groups.py index e8a24d84..0d79cae2 100755 --- a/scripts/utility/get_groups.py +++ b/scripts/utility/get_groups.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- import urllib diff --git a/scripts/utility/is_master_repository.py b/scripts/utility/is_master_repository.py index da5fb56f..c39914e1 100755 --- a/scripts/utility/is_master_repository.py +++ b/scripts/utility/is_master_repository.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 import subprocess pipe = subprocess.Popen("git config --get remote.origin.url", \ diff --git a/scripts/utility/qp_path.py b/scripts/utility/qp_path.py index f997ec21..eab6076c 100644 --- a/scripts/utility/qp_path.py +++ b/scripts/utility/qp_path.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 # -*- coding: utf-8 -*- import os From db72510ce4fda56abc44f8bb85a1f6b2b8f17ddc Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 2 May 2018 19:52:23 +0200 Subject: [PATCH 64/65] Python2 --- configure.py => configure | 2 +- plugins/All_singles/H_apply.irp.f | 2 +- plugins/CID/H_apply.irp.f | 2 +- plugins/CID_selected/H_apply.irp.f | 4 ++-- plugins/CIS/H_apply.irp.f | 2 +- plugins/CISD/H_apply.irp.f | 2 +- plugins/CISD_SC2_selected/H_apply.irp.f | 2 +- plugins/CISD_selected/H_apply.irp.f | 4 ++-- plugins/FOBOCI/H_apply.irp.f | 2 +- plugins/Full_CI/H_apply.irp.f | 2 +- plugins/MP2/H_apply.irp.f | 2 +- plugins/MRCC_Utils/H_apply.irp.f | 2 +- plugins/MRPT_Utils/H_apply.irp.f | 2 +- plugins/Perturbation/perturbation.irp.f | 2 +- plugins/Perturbation/perturbation.template.f | 2 +- plugins/QMC/qp_convert_qmcpack_to_ezfio.py | 2 +- scripts/compilation/qp_create_ninja.py | 7 ------- src/DavidsonUndressed/guess_lowest_state.irp.f | 2 +- 18 files changed, 19 insertions(+), 26 deletions(-) rename configure.py => configure (99%) diff --git a/configure.py b/configure similarity index 99% rename from configure.py rename to configure index 19c2c2fe..9bc8f24b 100755 --- a/configure.py +++ b/configure @@ -242,7 +242,7 @@ def checking(d_dependency): version = check_output("irpf90 -v".split()).strip() from distutils.version import LooseVersion - if LooseVersion(version) < LooseVersion("1.6.7"): + if LooseVersion(version) < LooseVersion("1.7.2"): return 0 else: return a diff --git a/plugins/All_singles/H_apply.irp.f b/plugins/All_singles/H_apply.irp.f index 04eb1804..24180cba 100644 --- a/plugins/All_singles/H_apply.irp.f +++ b/plugins/All_singles/H_apply.irp.f @@ -1,5 +1,5 @@ use bitmasks -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import * s = H_apply("just_1h_1p") diff --git a/plugins/CID/H_apply.irp.f b/plugins/CID/H_apply.irp.f index 41584070..600c092f 100644 --- a/plugins/CID/H_apply.irp.f +++ b/plugins/CID/H_apply.irp.f @@ -1,7 +1,7 @@ ! Generates subroutine H_apply_cid ! ---------------------------------- -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import H_apply H = H_apply("cid",do_double_exc=True,do_mono_exc=False) print H diff --git a/plugins/CID_selected/H_apply.irp.f b/plugins/CID_selected/H_apply.irp.f index e3afaa9d..f11e599a 100644 --- a/plugins/CID_selected/H_apply.irp.f +++ b/plugins/CID_selected/H_apply.irp.f @@ -1,5 +1,5 @@ use bitmasks -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import * from perturbation import perturbations @@ -16,7 +16,7 @@ subroutine H_apply_cisd_selection(perturbation,pt2, norm_pert, H_pert_diag, N_st integer, intent(in) :: N_st double precision, intent(inout):: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st) -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from perturbation import perturbations for perturbation in perturbations: diff --git a/plugins/CIS/H_apply.irp.f b/plugins/CIS/H_apply.irp.f index cf68267e..929f01e7 100644 --- a/plugins/CIS/H_apply.irp.f +++ b/plugins/CIS/H_apply.irp.f @@ -1,7 +1,7 @@ ! Generates subroutine H_apply_cisd ! ---------------------------------- -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import H_apply H = H_apply("cis",do_double_exc=False) print H diff --git a/plugins/CISD/H_apply.irp.f b/plugins/CISD/H_apply.irp.f index 0df1da38..a66c997d 100644 --- a/plugins/CISD/H_apply.irp.f +++ b/plugins/CISD/H_apply.irp.f @@ -1,7 +1,7 @@ ! Generates subroutine H_apply_cisd ! ---------------------------------- -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import H_apply H = H_apply("cisd") print H diff --git a/plugins/CISD_SC2_selected/H_apply.irp.f b/plugins/CISD_SC2_selected/H_apply.irp.f index 76e3d95e..85371597 100644 --- a/plugins/CISD_SC2_selected/H_apply.irp.f +++ b/plugins/CISD_SC2_selected/H_apply.irp.f @@ -1,5 +1,5 @@ use bitmasks -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import * from perturbation import perturbations diff --git a/plugins/CISD_selected/H_apply.irp.f b/plugins/CISD_selected/H_apply.irp.f index 91dfb9fc..8106105f 100644 --- a/plugins/CISD_selected/H_apply.irp.f +++ b/plugins/CISD_selected/H_apply.irp.f @@ -1,5 +1,5 @@ use bitmasks -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import * from perturbation import perturbations @@ -16,7 +16,7 @@ subroutine H_apply_cisd_selection(perturbation,pt2, norm_pert, H_pert_diag, N_st integer, intent(in) :: N_st double precision, intent(inout):: pt2(N_st), norm_pert(N_st), H_pert_diag(N_st) -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from perturbation import perturbations for perturbation in perturbations: diff --git a/plugins/FOBOCI/H_apply.irp.f b/plugins/FOBOCI/H_apply.irp.f index d8ab02f1..5de9d124 100644 --- a/plugins/FOBOCI/H_apply.irp.f +++ b/plugins/FOBOCI/H_apply.irp.f @@ -1,5 +1,5 @@ use bitmasks -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import * s = H_apply("just_1h_1p") diff --git a/plugins/Full_CI/H_apply.irp.f b/plugins/Full_CI/H_apply.irp.f index a37e2165..bbfc67bb 100644 --- a/plugins/Full_CI/H_apply.irp.f +++ b/plugins/Full_CI/H_apply.irp.f @@ -1,5 +1,5 @@ use bitmasks -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import * s = H_apply("FCI") diff --git a/plugins/MP2/H_apply.irp.f b/plugins/MP2/H_apply.irp.f index a5489149..c9842a4a 100644 --- a/plugins/MP2/H_apply.irp.f +++ b/plugins/MP2/H_apply.irp.f @@ -1,5 +1,5 @@ use bitmasks -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import * from perturbation import perturbations diff --git a/plugins/MRCC_Utils/H_apply.irp.f b/plugins/MRCC_Utils/H_apply.irp.f index 7fedd1a8..375aa603 100644 --- a/plugins/MRCC_Utils/H_apply.irp.f +++ b/plugins/MRCC_Utils/H_apply.irp.f @@ -1,5 +1,5 @@ use bitmasks -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import * s = H_apply("mrcc") diff --git a/plugins/MRPT_Utils/H_apply.irp.f b/plugins/MRPT_Utils/H_apply.irp.f index 6f17ab05..ee922fc4 100644 --- a/plugins/MRPT_Utils/H_apply.irp.f +++ b/plugins/MRPT_Utils/H_apply.irp.f @@ -1,5 +1,5 @@ use bitmasks -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from generate_h_apply import * s = H_apply("mrpt") diff --git a/plugins/Perturbation/perturbation.irp.f b/plugins/Perturbation/perturbation.irp.f index 208deab5..f7d1f478 100644 --- a/plugins/Perturbation/perturbation.irp.f +++ b/plugins/Perturbation/perturbation.irp.f @@ -1,4 +1,4 @@ -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] from perturbation import perturbations import os diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index a445bec0..6da5028f 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -1,4 +1,4 @@ -BEGIN_SHELL [ /usr/bin/env python ] +BEGIN_SHELL [ /usr/bin/env python2 ] import perturbation END_SHELL diff --git a/plugins/QMC/qp_convert_qmcpack_to_ezfio.py b/plugins/QMC/qp_convert_qmcpack_to_ezfio.py index 94f0c347..54f6b5b5 100755 --- a/plugins/QMC/qp_convert_qmcpack_to_ezfio.py +++ b/plugins/QMC/qp_convert_qmcpack_to_ezfio.py @@ -1,4 +1,4 @@ -#!/usr/bin/python +#!/usr/bin/env python2 print "#QP -> QMCPACK" diff --git a/scripts/compilation/qp_create_ninja.py b/scripts/compilation/qp_create_ninja.py index f1164627..fd20c3dc 100755 --- a/scripts/compilation/qp_create_ninja.py +++ b/scripts/compilation/qp_create_ninja.py @@ -25,7 +25,6 @@ except ImportError: "quantum_package.rc")) print "\n".join(["", "Error:", "source %s" % f, ""]) - raise sys.exit(1) @@ -820,13 +819,8 @@ if __name__ == "__main__": pickle_path = os.path.join(QP_ROOT, "config", "qp_create_ninja.pickle") if arguments["update"]: - try: with open(pickle_path, 'rb') as handle: arguments = pickle.load(handle) - except IOError: - print "You need to create first my friend" - raise - sys.exit(1) elif arguments["create"]: @@ -928,7 +922,6 @@ if __name__ == "__main__": "- Or install a module that needs {0} with a main "] print "\n".join(l_msg).format(module.rel) - raise sys.exit(1) # ~#~#~#~#~#~#~#~#~#~#~#~ # diff --git a/src/DavidsonUndressed/guess_lowest_state.irp.f b/src/DavidsonUndressed/guess_lowest_state.irp.f index f6d0a004..f827e86b 100644 --- a/src/DavidsonUndressed/guess_lowest_state.irp.f +++ b/src/DavidsonUndressed/guess_lowest_state.irp.f @@ -72,7 +72,7 @@ program first_guess call write_int(6,psi_det_size,'psi_det_size') TOUCH psi_det_size -BEGIN_SHELL [ /usr/bin/python ] +BEGIN_SHELL [ /usr/bin/env python2 ] template_alpha_ext = """ do %(i2)s = %(i1)s-1,1,-1 From b91c9ebad13c0a19f8fb54332ad5aa55acd06afa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 7 May 2018 12:06:25 +0200 Subject: [PATCH 65/65] Merge Anouar (#69) * Converter for Pyscf * Scripts to read integrals and metadata and generates fake ezfio * update README * Trying to fix jbuilder bug in OCaml installation * Do AO->MO transformation from pyscf in QP * Optimization of reader due to format creux * Optimization of reader due to format creux 2 --- plugins/QMC/qp_convert_qmcpack_to_ezfio.py | 41 +++++- plugins/pyscf/NEEDED_CHILDREN_MODULES | 1 + plugins/pyscf/PyscfToQp.py | 137 ++++++++++++++++++ plugins/pyscf/README.rst | 21 +++ plugins/pyscf/pyscf.main.irp.f | 38 +++++ .../read_integral/Gen_Ezfio_from_integral.sh | 17 +++ plugins/read_integral/README.rst | 1 + plugins/read_integral/create_ezfio.py | 48 ++++++ .../read_integrals_achocol.irp.f | 47 ++++++ .../read_integrals_mo_chocol.irp.f | 86 +++++++++++ 10 files changed, 432 insertions(+), 5 deletions(-) create mode 100644 plugins/pyscf/NEEDED_CHILDREN_MODULES create mode 100644 plugins/pyscf/PyscfToQp.py create mode 100644 plugins/pyscf/README.rst create mode 100644 plugins/pyscf/pyscf.main.irp.f create mode 100755 plugins/read_integral/Gen_Ezfio_from_integral.sh create mode 100755 plugins/read_integral/create_ezfio.py create mode 100644 plugins/read_integral/read_integrals_achocol.irp.f create mode 100644 plugins/read_integral/read_integrals_mo_chocol.irp.f diff --git a/plugins/QMC/qp_convert_qmcpack_to_ezfio.py b/plugins/QMC/qp_convert_qmcpack_to_ezfio.py index 54f6b5b5..b6237476 100755 --- a/plugins/QMC/qp_convert_qmcpack_to_ezfio.py +++ b/plugins/QMC/qp_convert_qmcpack_to_ezfio.py @@ -333,11 +333,14 @@ if do_pseudo: # |_/ (/_ |_ # + psi_coef = ezfio.get_determinants_psi_coef() psi_det = ezfio.get_determinants_psi_det() bit_kind = ezfio.get_determinants_bit_kind() +nexcitedstate = ezfio.get_determinants_n_states() + print "" print "BEGIN_DET" print "" @@ -349,7 +352,11 @@ if "QP_STATE" in os.environ: state = int(os.environ["QP_STATE"])-1 else: state = 0 -psi_coef = psi_coef[state] + +psi_coef_small = psi_coef[state] + + + encode = 8*bit_kind @@ -359,11 +366,35 @@ def bindigits(n, bits): decode = lambda det: ''.join(bindigits(i,encode)[::-1] for i in det)[:mo_num] -for coef, (det_a, det_b) in zip(psi_coef, psi_det): +MultiDetAlpha = [] +MultiDetBeta = [] +for coef, (det_a, det_b) in zip(psi_coef_small, psi_det): print coef - print decode(det_a) - print decode(det_b) + MyDetA=decode(det_a) + MyDetB=decode(det_b) + print MyDetA + print MyDetB print '' - + MultiDetAlpha.append( det_a ) + MultiDetBeta.append( det_b ) print "END_DET" + +import h5py +H5_qmcpack=h5py.File('MultiDet.h5','w') +groupMultiDet=H5_qmcpack.create_group("MultiDet") +groupMultiDet.create_dataset("NbDet",(1,),dtype="f8",data=len(psi_coef_small)) + +groupMultiDet.create_dataset("Coeff",(len(psi_coef_small),),dtype="f8",data=psi_coef) +groupMultiDet.create_dataset("nstate",(1,),dtype="i4",data=len(MyDetA)) +groupMultiDet.create_dataset("nexcitedstate",(1,),dtype="i4",data=nexcitedstate) +groupMultiDet.create_dataset("Nbits",(1,),dtype="i4",data=len(det_a)) + +print "temp=",MultiDetAlpha[0] +mylen="S"+str(len(MyDetA)) +groupMultiDet.create_dataset("CI_Alpha",(len(psi_coef_small),len(det_a)),dtype='i8',data=MultiDetAlpha) + +mylen="S"+str(len(MyDetB)) +groupMultiDet.create_dataset("CI_Beta",(len(psi_coef_small),len(det_b)),dtype='i8',data=MultiDetBeta) + +H5_qmcpack.close() diff --git a/plugins/pyscf/NEEDED_CHILDREN_MODULES b/plugins/pyscf/NEEDED_CHILDREN_MODULES new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/plugins/pyscf/NEEDED_CHILDREN_MODULES @@ -0,0 +1 @@ + diff --git a/plugins/pyscf/PyscfToQp.py b/plugins/pyscf/PyscfToQp.py new file mode 100644 index 00000000..74ef951c --- /dev/null +++ b/plugins/pyscf/PyscfToQp.py @@ -0,0 +1,137 @@ + +import numpy,re,sys + +def pyscf2QP(cell,mf, kpts=[], int_threshold = 1E-15): + # The integral will be not printed in they are bellow that + + + PBC=False + ComputeMode= re.split('[. ]', str(mf)) + print 'ComputeMode=',ComputeMode + + for n in ComputeMode: + if n in ("UHF","KUHF","UKS"): + sys.exit('Unrestricted calculation unsupported in Quantum Package') + if n == "pbc": + PBC=True + + if PBC and len(kpts) == 0: + sys.exit("ERROR (read!): You need to specify explicit the list of K-point (including gamma)") + + print 'Performing PBC?:',PBC + if PBC: + from pyscf.pbc import ao2mo + from pyscf.pbc import tools + else: + from pyscf import ao2mo + + natom = len(cell.atom_coords()) + print 'n_atom', natom + print 'num_elec', cell.nelectron + print 'nucl_num', len(cell.atom_coords()) + + + print '' + mo_coeff = mf.mo_coeff # List of mo_coeff for each k-point + if not PBC: + nmo = mo_coeff.shape[1] + else: + nmo = mo_coeff[0].shape[1] + + + # Wrote all the parameter need to creat a dummy EZFIO folder who will containt the integral after. + # More an implentation detail than a real thing + with open('param','w') as f: + f.write(' '.join(map(str,(cell.nelectron, nmo, natom)))) + # _ + # |\ | _ | _ _. ._ |_) _ ._ | _ o _ ._ + # | \| |_| (_ | (/_ (_| | | \ (/_ |_) |_| | _> | (_) | | + # | + + print 'mf, cell', mf.energy_nuc(), cell.energy_nuc() + shift = tools.pbc.madelung(cell, numpy.zeros(3))*cell.nelectron * -.5 if PBC else 0 + e_nuc = cell.energy_nuc() + shift + + print 'nucl_repul', e_nuc + with open('e_nuc','w') as f: + f.write(str(e_nuc)) + + + from itertools import product + + # ___ + # | ._ _|_ _ _ ._ _. | _ |\/| _ ._ _ + # _|_ | | |_ (/_ (_| | (_| | _> | | (_) | | (_) + # _| + + if PBC: + h_ao = ('kinetic', mf.get_hcore(kpts=kpts) ) # Give only one k point ? + dummy_ao = ('nuclear', numpy.zeros( (len(kpts),nmo,nmo), dtype=numpy.float )) + else: + h_ao = ('kinetic', mf.get_hcore() ) + dummy_ao = ('nuclear', numpy.zeros( (nmo,nmo), dtype=numpy.float )) + + def gen_mono_MO(mo_coeff,l_int,shift=0): + # 2Id transfortion Transformation. For now we handle only one or zero K point. + print 'l_int.shape=',l_int.shape + + l_int_mo = reduce(numpy.dot, (mo_coeff.T, l_int, mo_coeff)) #This formula is only right for one kpt. + + print 'l_int_mo=',l_int_mo + + for i,j in product(range(nmo), repeat=2): + int_ = l_int_mo[i,j] + yield (i+1+shift,j+1+shift, int_) + + # Print + for name, ao in (h_ao,dummy_ao): + with open('%s_mo' % name,'w') as f: + print '%s_mo' % name + if not PBC: + for mono in gen_mono_MO(mo_coeff,ao): + f.write('%s %s %s\n'% mono) + else: + for i,(m,a) in enumerate(zip(mo_coeff,ao)): + for mono in gen_mono_MO(m,a,i): + f.write('%s %s %s\n'% mono) + + # ___ _ + # | ._ _|_ _ _ ._ _. | _ |_) o + # _|_ | | |_ (/_ (_| | (_| | _> |_) | + # _| + # + + def ao2mo_amazing(mo_coeff): + if PBC: + eri_4d= mf.with_df.ao2mo(mo_coeff,compact=False) + else: + eri_4d= ao2mo.kernel(cell,mo_coeff,compact=False) + + return eri_4d.reshape((nmo,)*4) + + + def write_amazing(eri_4d, shift=0): + + # HANDLE 8 FOLD by Scemama way. Maybe we can use compact=True + for l in range(nmo): + for k in range(nmo): + for j in range(l,nmo): + for i in range(max(j,k),nmo): + v = eri_4d[i,k,j,l] + if abs(v) > int_threshold: + f.write('%s %s %s %s %s\n' % (i+1+shift,j+1+shift,k+1+shift,l+1+shift,v)) + + + if PBC: + eri_4d= mf.with_df.ao2mo(mo_coeff[0],compact=False) + else: #Molecular + eri_4d= ao2mo.kernel(cell,mo_coeff,compact=False) + + eri_4d = eri_4d.reshape((nmo,)*4) + + f = open('bielec_mo','w') + for i,mc in enumerate(mo_coeff): + eri = ao2mo_amazing(mc) + write_amazing(eri, nmo*i) + + diff --git a/plugins/pyscf/README.rst b/plugins/pyscf/README.rst new file mode 100644 index 00000000..6588ef08 --- /dev/null +++ b/plugins/pyscf/README.rst @@ -0,0 +1,21 @@ +===== +pyscf +===== +Converter from Pyscf to Quatum Package for Molecules AND Solids +Import this script in your Pyscf input. + + +Use as follow: +``` + from MolPyscfToQP import pyscf2QP + pyscf2QP(cell,mf,kpts=kpts,int_threshold = 1E-15) + +``` +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. diff --git a/plugins/pyscf/pyscf.main.irp.f b/plugins/pyscf/pyscf.main.irp.f new file mode 100644 index 00000000..dc2013c2 --- /dev/null +++ b/plugins/pyscf/pyscf.main.irp.f @@ -0,0 +1,38 @@ +program pyscf + implicit none + BEGIN_DOC +! TODO + END_DOC + print *, ' _/ ' + print *, ' -:\_?, _Jm####La ' + print *, 'J"(:" > _]#AZ#Z#UUZ##, ' + print *, '_,::./ %(|i%12XmX1*1XL _?, ' + print *, ' \..\ _\(vmWQwodY+ia%lnL _",/ ( ' + print *, ' .:< ]J=mQD?WXn|,)nr" ' + print *, ' 4XZ#Xov1v}=)vnXAX1nnv;1n" ' + print *, ' ]XX#ZXoovvvivnnnlvvo2*i7 ' + print *, ' "23Z#1S2oo2XXSnnnoSo2>v" ' + print *, ' miX#L -~`""!!1}oSoe|i7 ' + print *, ' 4cn#m, v221=|v[ ' + print *, ' ]hI3Zma,;..__wXSe=+vo ' + print *, ' ]Zov*XSUXXZXZXSe||vo2 ' + print *, ' ]Z#>=|< ' + print *, ' -ziiiii||||||+||==+> ' + print *, ' -%|+++||=|=+|=|==/ ' + print *, ' -a>====+|====-:- ' + print *, ' "~,- -- /- ' + print *, ' -. )> ' + print *, ' .~ +- ' + print *, ' . .... : . ' + print *, ' -------~ ' + print *, '' +end diff --git a/plugins/read_integral/Gen_Ezfio_from_integral.sh b/plugins/read_integral/Gen_Ezfio_from_integral.sh new file mode 100755 index 00000000..d190ffae --- /dev/null +++ b/plugins/read_integral/Gen_Ezfio_from_integral.sh @@ -0,0 +1,17 @@ +#!/bin/bash + +ezfio=$1 +# Create the integral +echo 'Create Integral' + +echo 'Create EZFIO' +read nel nmo natom <<< $(cat param) +read e_nucl <<< $(cat e_nuc) +./create_ezfio.py $ezfio $nel $natom $nmo $e_nucl +#Handle the orbital consitensy check +qp_edit -c $ezfio &> /dev/null +cp $ezfio/{ao,mo}_basis/ao_md5 + +#Read the integral +echo 'Read Integral' +qp_run read_integrals_mo $ezfio diff --git a/plugins/read_integral/README.rst b/plugins/read_integral/README.rst index 02b63512..a027ede8 100644 --- a/plugins/read_integral/README.rst +++ b/plugins/read_integral/README.rst @@ -3,6 +3,7 @@ read_integral ============= Warning: CAN NOT CHANGE THE NUMBER OF MO ! +Scripts to read integrals and metadata and generates fake ezfio Needed Modules ============== diff --git a/plugins/read_integral/create_ezfio.py b/plugins/read_integral/create_ezfio.py new file mode 100755 index 00000000..acad3441 --- /dev/null +++ b/plugins/read_integral/create_ezfio.py @@ -0,0 +1,48 @@ +#!/usr/bin/env python +from ezfio import ezfio + +import sys +filename = sys.argv[1] +num_elec, nucl_num, mo_tot_num = map(int,sys.argv[2:5]) + +nuclear_repulsion = float(sys.argv[5]) +ezfio.set_file(filename) + +#Important ! +import math +ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) +ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + + +#Important +ezfio.set_nuclei_nucl_num(nucl_num) +ezfio.set_nuclei_nucl_charge([0.]*nucl_num) +ezfio.set_nuclei_nucl_coord( [ [0.], [0.], [0.] ]*nucl_num ) +ezfio.set_nuclei_nucl_label( ['He'] * nucl_num ) + +ezfio.set_nuclei_disk_access_nuclear_repulsion('Read') +ezfio.set_nuclei_nuclear_repulsion(nuclear_repulsion) + +# Ao num +ao_num = mo_tot_num +ezfio.set_ao_basis_ao_basis("Dummy one. We read MO") +ezfio.set_ao_basis_ao_num(ao_num) +ezfio.set_ao_basis_ao_nucl([1]*ao_num) #Maybe put a realy incorrect stuff + +#Just need one +ao_prim_num_max = 5 + +d = [ [0] *ao_prim_num_max]*ao_num +ezfio.set_ao_basis_ao_prim_num([ao_prim_num_max]*ao_num) +ezfio.set_ao_basis_ao_power(d) +ezfio.set_ao_basis_ao_coef(d) +ezfio.set_ao_basis_ao_expo(d) + +#Dummy one +ao_md5 = '3b8b464dfc95f282129bde3efef3c502' +ezfio.set_ao_basis_ao_md5(ao_md5) +ezfio.set_mo_basis_ao_md5(ao_md5) + + +ezfio.set_mo_basis_mo_tot_num(mo_tot_num) +ezfio.set_mo_basis_mo_coef([ [0]*mo_tot_num] * ao_num) diff --git a/plugins/read_integral/read_integrals_achocol.irp.f b/plugins/read_integral/read_integrals_achocol.irp.f new file mode 100644 index 00000000..d6b51b25 --- /dev/null +++ b/plugins/read_integral/read_integrals_achocol.irp.f @@ -0,0 +1,47 @@ +program read_integrals + + PROVIDE ezfio_filename + call ezfio_set_integrals_monoelec_disk_access_ao_one_integrals("None") + call run +end + +subroutine run + use map_module + implicit none + + integer :: iunit + integer :: getunitandopen + + integer ::i,j,k,l + double precision :: integral + double precision, allocatable :: A(:,:) + + integer :: n_integrals + integer(key_kind), allocatable :: buffer_i(:) + real(integral_kind), allocatable :: buffer_values(:) + integer(key_kind) :: key + + call ezfio_set_integrals_monoelec_disk_access_ao_one_integrals("Read") + + allocate(buffer_i(ao_num**4/8), buffer_values(ao_num**4/8)) + + iunit = getunitandopen('bielec_ao','r') + n_integrals=0 + do + read (iunit,*,end=13) i,j,k,l, integral + n_integrals += 1 + call bielec_integrals_index(i, j, k, l, buffer_i(n_integrals) ) + buffer_values(n_integrals) = integral + enddo + 13 continue + close(iunit) + + call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_values) + + call map_sort(ao_integrals_map) + call map_unique(ao_integrals_map) + + call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map) + call ezfio_set_integrals_bielec_disk_access_ao_integrals('Read') + +end diff --git a/plugins/read_integral/read_integrals_mo_chocol.irp.f b/plugins/read_integral/read_integrals_mo_chocol.irp.f new file mode 100644 index 00000000..8e5fde8e --- /dev/null +++ b/plugins/read_integral/read_integrals_mo_chocol.irp.f @@ -0,0 +1,86 @@ +program read_integrals + BEGIN_DOC +! Reads the integrals from the following files: +! - kinetic_mo +! - nuclear_mo +! - bielec_mo + END_DOC + + integer :: iunit + integer :: getunitandopen + integer :: i,j,n + + PROVIDE ezfio_filename + call ezfio_set_integrals_monoelec_disk_access_mo_one_integrals("None") + + logical :: has + call ezfio_has_mo_basis_mo_tot_num(has) + if (.not.has) then + + iunit = getunitandopen('nuclear_mo','r') + n=0 + do + read (iunit,*,end=12) i + n = max(n,i) + enddo + 12 continue + close(iunit) + call ezfio_set_mo_basis_mo_tot_num(n) + + call ezfio_has_ao_basis_ao_num(has) + mo_label = "None" + if (has) then + call huckel_guess + else + call ezfio_set_ao_basis_ao_num(n) + endif + endif + call run +end + +subroutine run + use map_module + implicit none + + integer :: iunit + integer :: getunitandopen + + integer ::i,j,k,l + double precision :: integral + double precision, allocatable :: A(:,:) + + integer :: n_integrals + integer(key_kind), allocatable :: buffer_i(:) + real(integral_kind), allocatable :: buffer_values(:) + integer(key_kind) :: key + + call ezfio_get_mo_basis_mo_tot_num(mo_tot_num) + + allocate (A(mo_tot_num,mo_tot_num)) + A = 0.d0 + + iunit = getunitandopen('kinetic_mo','r') + do + read (iunit,*,end=10) i,j, integral + A(i,j) = integral + enddo + 10 continue + close(iunit) + call write_one_e_integrals('mo_kinetic_integral', A, size(A,1), size(A,2)) + + + iunit = getunitandopen('nuclear_mo','r') + do + read (iunit,*,end=12) i,j, integral + A(i,j) = integral + enddo + 12 continue + close(iunit) + call write_one_e_integrals('mo_ne_integral', A, size(A,1), size(A,2)) + + call write_one_e_integrals('mo_pseudo_integral', mo_pseudo_integral,& + size(mo_pseudo_integral,1), size(mo_pseudo_integral,2)) + + + call ezfio_set_integrals_monoelec_disk_access_mo_one_integrals("Read") +end