From 6c73330855dfa4fb7bb2fc4997bbb9dd89e7e857 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 27 Jun 2018 15:20:33 +0200 Subject: [PATCH] Fixed MRCC --- plugins/Bk/NEEDED_CHILDREN_MODULES | 2 +- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 17 +- .../Full_CI_ZMQ_GPI2/NEEDED_CHILDREN_MODULES | 1 - plugins/Full_CI_ZMQ_GPI2/README.rst | 15 -- .../selection_davidson_slave_gpi2.irp.f | 105 -------- plugins/GPI2/broadcast.irp.f | 254 ------------------ plugins/MRPT_Utils/mrpt_utils.irp.f | 80 +++--- plugins/dress_zmq/EZFIO.cfg | 17 -- plugins/dress_zmq/dressing_vector.irp.f | 1 - plugins/mrcc_sto/NEEDED_CHILDREN_MODULES | 1 - plugins/mrcc_sto/README.rst | 12 - plugins/mrcc_sto/mrcc_sto.irp.f | 240 ----------------- plugins/mrcepa0/dressing.irp.f | 170 ++---------- plugins/mrcepa0/dressing_slave.irp.f | 8 +- plugins/mrcepa0/dressing_vector.irp.f | 10 +- plugins/mrcepa0/mrcc.irp.f | 2 +- plugins/mrcepa0/mrcc_omp.irp.f | 27 -- plugins/mrcepa0/mrcc_stoch_routines.irp.f | 5 +- plugins/mrcepa0/mrcc_zmq.irp.f | 4 + .../read_integral/Gen_Ezfio_from_integral.sh | 17 -- plugins/shiftedbk/EZFIO.cfg | 55 ++-- tests/bats/mrcepa0.bats | 42 ++- tests/bats_to_sh.py | 2 +- 23 files changed, 137 insertions(+), 950 deletions(-) delete mode 100644 plugins/Full_CI_ZMQ_GPI2/NEEDED_CHILDREN_MODULES delete mode 100644 plugins/Full_CI_ZMQ_GPI2/README.rst delete mode 100644 plugins/Full_CI_ZMQ_GPI2/selection_davidson_slave_gpi2.irp.f delete mode 100644 plugins/GPI2/broadcast.irp.f delete mode 100644 plugins/dress_zmq/EZFIO.cfg delete mode 100644 plugins/mrcc_sto/NEEDED_CHILDREN_MODULES delete mode 100644 plugins/mrcc_sto/README.rst delete mode 100644 plugins/mrcc_sto/mrcc_sto.irp.f delete mode 100644 plugins/mrcepa0/mrcc_omp.irp.f delete mode 100755 plugins/read_integral/Gen_Ezfio_from_integral.sh diff --git a/plugins/Bk/NEEDED_CHILDREN_MODULES b/plugins/Bk/NEEDED_CHILDREN_MODULES index 6bcca9aa..709c29ec 100644 --- a/plugins/Bk/NEEDED_CHILDREN_MODULES +++ b/plugins/Bk/NEEDED_CHILDREN_MODULES @@ -1,2 +1,2 @@ -Bitmask dress_zmq DavidsonDressed +Bitmask dress_zmq DavidsonDressed Generators_full Selectors_full diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index 8ebbdff7..95759730 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -341,12 +341,12 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_ prop = prop * pt2_weight_inv(first_det_of_teeth(tooth)) E0 += pt2_detail(pt2_stoch_istate,first_det_of_teeth(tooth)) * prop avg = E0 + (sumabove(tooth) / Nabove(tooth)) - eqt = sqrt(1d0 / (Nabove(tooth)-1) * abs(sum2above(tooth) / Nabove(tooth) - (sumabove(tooth)/Nabove(tooth))**2)) + eqt = sqrt(1d0 / (Nabove(tooth)-1.d0) * abs(sum2above(tooth) / Nabove(tooth) - (sumabove(tooth)/Nabove(tooth))**2)) else eqt = 0.d0 endif call wall_time(time) - if ( ((dabs(eqt/avg) < relative_error) .or. (dabs(eqt) < absolute_error)) .and. Nabove(tooth) >= 10) then + if ( ((dabs(eqt/avg) < relative_error) .or. (dabs(eqt) < absolute_error)) .and. Nabove(tooth) >= 10.d0) then ! Termination pt2(pt2_stoch_istate) = avg error(pt2_stoch_istate) = eqt @@ -358,7 +358,7 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_ endif endif else - if (Nabove(tooth) > Nabove_old) then + if ( (Nabove(tooth) > 2.d0) .and. (Nabove(tooth) > Nabove_old) ) then print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, '' Nabove_old = Nabove(tooth) endif @@ -378,16 +378,7 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_ pt2(pt2_stoch_istate) = E0 + (sumabove(tooth) / Nabove(tooth)) error(pt2_stoch_istate) = sqrt(1d0 / (Nabove(tooth)-1) * abs(sum2above(tooth) / Nabove(tooth) - (sumabove(tooth)/Nabove(tooth))**2)) end if - -!======= -! -! 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)) -! E0 += pt2_detail(pt2_stoch_istate,first_det_of_teeth(tooth)) * prop -! pt2(pt2_stoch_istate) = E0 + (sumabove(tooth) / Nabove(tooth)) -! -!>>>>>>> master + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call sort_selection_buffer(b) end subroutine diff --git a/plugins/Full_CI_ZMQ_GPI2/NEEDED_CHILDREN_MODULES b/plugins/Full_CI_ZMQ_GPI2/NEEDED_CHILDREN_MODULES deleted file mode 100644 index dd79ddf2..00000000 --- a/plugins/Full_CI_ZMQ_GPI2/NEEDED_CHILDREN_MODULES +++ /dev/null @@ -1 +0,0 @@ -Full_CI_ZMQ GPI2 diff --git a/plugins/Full_CI_ZMQ_GPI2/README.rst b/plugins/Full_CI_ZMQ_GPI2/README.rst deleted file mode 100644 index b3e89d9e..00000000 --- a/plugins/Full_CI_ZMQ_GPI2/README.rst +++ /dev/null @@ -1,15 +0,0 @@ -================ -Full_CI_ZMQ_GPI2 -================ - -GPI2 Slave for Full_CI with ZMQ. There should be one instance of the slave -per compute node. - -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/Full_CI_ZMQ_GPI2/selection_davidson_slave_gpi2.irp.f b/plugins/Full_CI_ZMQ_GPI2/selection_davidson_slave_gpi2.irp.f deleted file mode 100644 index 52822e41..00000000 --- a/plugins/Full_CI_ZMQ_GPI2/selection_davidson_slave_gpi2.irp.f +++ /dev/null @@ -1,105 +0,0 @@ -program selection_slave - implicit none - BEGIN_DOC -! Helper program to compute the PT2 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 - PROVIDE pt2_e0_denominator mo_tot_num N_int fragment_count GASPI_is_Initialized -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) - character*(64) :: states(4) - integer :: rc, i, ierr - - call provide_everything - - zmq_context = f77_zmq_ctx_new () - states(1) = 'selection' - states(2) = 'davidson' - states(3) = 'pt2' - - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - - do - - call wait_for_states(states,zmq_state,3) - - if(trim(zmq_state) == 'Stopped') then - - exit - - else if (trim(zmq_state) == 'selection') then - - ! Selection - ! --------- - - print *, 'Selection' - if (is_gaspi_master) then - call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states) - endif - call broadcast_wf(energy) - - !$OMP PARALLEL PRIVATE(i) - i = omp_get_thread_num() - call run_selection_slave(0,i,energy) - !$OMP END PARALLEL - print *, 'Selection done' - - else if (trim(zmq_state) == 'davidson') then - - ! Davidson - ! -------- - - print *, 'Davidson' - if (is_gaspi_master) then - call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states) - endif - call broadcast_wf(energy) - call omp_set_nested(.True.) - call davidson_slave_tcp(0) - call omp_set_nested(.False.) - print *, 'Davidson done' - - else if (trim(zmq_state) == 'pt2') then - - ! PT2 - ! --- - - print *, 'PT2' - if (is_gaspi_master) then - call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states) - endif - call broadcast_wf(energy) - - logical :: lstop - lstop = .False. - !$OMP PARALLEL PRIVATE(i) - i = omp_get_thread_num() - call run_pt2_slave(0,i,energy,lstop) - !$OMP END PARALLEL - print *, 'PT2 done' - - endif - - end do -end - - - diff --git a/plugins/GPI2/broadcast.irp.f b/plugins/GPI2/broadcast.irp.f deleted file mode 100644 index e9f421d8..00000000 --- a/plugins/GPI2/broadcast.irp.f +++ /dev/null @@ -1,254 +0,0 @@ -subroutine broadcast_wf(energy) - implicit none - BEGIN_DOC - ! Segment corresponding to the wave function. This is segment 0. - END_DOC - use bitmasks - use GASPI - use ISO_C_BINDING - - double precision, intent(inout) :: energy(N_states) - integer(gaspi_return_t) :: res - - if (is_gaspi_master) then - call broadcast_wf_put(energy) - else - call broadcast_wf_get(energy) - endif - - res = gaspi_barrier(GASPI_GROUP_ALL, GASPI_BLOCK) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_barrier failed" - stop -1 - end if - - - integer(gaspi_segment_id_t) :: seg_id - do seg_id=0,3 - res = gaspi_segment_delete(seg_id) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_segment_delete failed", seg_id - stop -1 - end if - end do - -end - - - - - -subroutine broadcast_wf_put(energy) - implicit none - BEGIN_DOC - ! Initiates the broadcast of the wave function - END_DOC - use bitmasks - use GASPI - use ISO_C_BINDING - - double precision, intent(in) :: energy(N_states) - integer(gaspi_segment_id_t) :: seg_id - integer(gaspi_alloc_t) :: seg_alloc_policy - integer(gaspi_size_t) :: seg_size(0:3) - type(c_ptr) :: seg_ptr(0:3) - integer, pointer :: params_int(:) ! Segment 0 - double precision, pointer :: psi_coef_tmp(:,:) ! Segment 1 - integer(bit_kind), pointer :: psi_det_tmp(:,:,:) ! Segment 2 - double precision, pointer :: params_double(:) ! Segment 3 - - integer(gaspi_return_t) :: res - - - seg_alloc_policy = GASPI_MEM_UNINITIALIZED - - seg_size(0) = 4 * 5 - seg_id=0 - res = gaspi_segment_create(seg_id, seg_size(seg_id), GASPI_GROUP_ALL, & - GASPI_BLOCK, seg_alloc_policy) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_create_segment failed", gaspi_rank, seg_id - stop -1 - end if - - res = gaspi_segment_ptr(seg_id, seg_ptr(seg_id)) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_segment_ptr failed", gaspi_rank - stop -1 - end if - - call c_f_pointer(seg_ptr(0), params_int, shape=(/ 5 /)) - params_int(1) = N_states - params_int(2) = N_det - params_int(3) = psi_det_size - - res = gaspi_barrier(GASPI_GROUP_ALL, GASPI_BLOCK) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_barrier failed", gaspi_rank - stop -1 - end if - - seg_size(1) = 8 * psi_det_size * N_states - seg_size(2) = bit_kind * psi_det_size * 2 * N_int - seg_size(3) = 8 * N_states - - do seg_id=1, 3 - res = gaspi_segment_create(seg_id, seg_size(seg_id), GASPI_GROUP_ALL, & - GASPI_BLOCK, seg_alloc_policy) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_create_segment failed", gaspi_rank, seg_id - stop -1 - end if - - res = gaspi_segment_ptr(seg_id, seg_ptr(seg_id)) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_segment_ptr failed", gaspi_rank - stop -1 - end if - end do - - call c_f_pointer(seg_ptr(1), psi_coef_tmp, shape=shape(psi_coef)) - call c_f_pointer(seg_ptr(2), psi_det_tmp, shape=shape(psi_det)) - call c_f_pointer(seg_ptr(3), params_double, shape=(/ N_states /)) - - psi_coef_tmp = psi_coef - psi_det_tmp = psi_det - params_double = energy - - res = gaspi_barrier(GASPI_GROUP_ALL, GASPI_BLOCK) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_barrier failed", gaspi_rank - stop -1 - end if - -end - - - - - - - -subroutine broadcast_wf_get(energy) - implicit none - BEGIN_DOC - ! Gets the broadcasted wave function - END_DOC - use bitmasks - use GASPI - use ISO_C_BINDING - - double precision, intent(out) :: energy(N_states) - integer(gaspi_segment_id_t) :: seg_id - integer(gaspi_alloc_t) :: seg_alloc_policy - integer(gaspi_size_t) :: seg_size(0:3) - type(c_ptr) :: seg_ptr(0:3) - integer, pointer :: params_int(:) ! Segment 0 - double precision, pointer :: psi_coef_tmp(:,:) ! Segment 1 - integer(bit_kind), pointer :: psi_det_tmp(:,:,:) ! Segment 2 - double precision, pointer :: params_double(:) ! Segment 3 - - integer(gaspi_return_t) :: res - - - seg_alloc_policy = GASPI_MEM_UNINITIALIZED - - seg_size(0) = 4 * 5 - seg_id=0 - res = gaspi_segment_create(seg_id, seg_size(seg_id), GASPI_GROUP_ALL,& - GASPI_BLOCK, seg_alloc_policy) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_create_segment failed" - stop -1 - end if - - res = gaspi_segment_ptr(seg_id, seg_ptr(seg_id)) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_segment_ptr failed" - stop -1 - end if - - res = gaspi_barrier(GASPI_GROUP_ALL, GASPI_BLOCK) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_barrier failed" - stop -1 - end if - - integer(gaspi_offset_t) :: localOff, remoteOff - integer(gaspi_rank_t) :: remoteRank - integer(gaspi_queue_id_t) :: queue - localOff = 0 - remoteRank = 0 - queue = 0 - res = gaspi_read(seg_id, localOff, remoteRank, & - seg_id, remoteOff, seg_size(seg_id), queue, GASPI_BLOCK) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_read failed" - stop -1 - end if - - res = gaspi_wait(queue, GASPI_BLOCK) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_wait failed" - stop -1 - end if - - call c_f_pointer(seg_ptr(0), params_int, shape=shape( (/ 5 /) )) - - N_states = params_int(1) - N_det = params_int(2) - psi_det_size = params_int(3) - TOUCH N_states N_det psi_det_size - - seg_size(1) = 8 * psi_det_size * N_states - seg_size(2) = bit_kind * psi_det_size * 2 * N_int - seg_size(3) = 8 * N_states - - do seg_id=1, 3 - res = gaspi_segment_create(seg_id, seg_size(seg_id), GASPI_GROUP_ALL, & - GASPI_BLOCK, seg_alloc_policy) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_create_segment failed" - stop -1 - end if - - res = gaspi_segment_ptr(seg_id, seg_ptr(seg_id)) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_segment_ptr failed" - stop -1 - end if - end do - - res = gaspi_barrier(GASPI_GROUP_ALL, GASPI_BLOCK) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_barrier failed" - stop -1 - end if - - do seg_id=1, 3 - res = gaspi_read(seg_id, localOff, remoteRank, & - seg_id, remoteOff, seg_size(seg_id), queue, GASPI_BLOCK) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_read failed" - stop -1 - end if - res = gaspi_wait(queue, GASPI_BLOCK) - if(res .ne. GASPI_SUCCESS) then - write(*,*) "gaspi_wait failed" - stop -1 - end if - end do - - call c_f_pointer(seg_ptr(1), psi_coef_tmp, shape=shape(psi_coef)) - call c_f_pointer(seg_ptr(2), psi_det_tmp, shape=shape(psi_det)) - call c_f_pointer(seg_ptr(3), params_double, shape=shape(energy)) - - psi_coef = psi_coef_tmp - psi_det = psi_det_tmp - energy = params_double - -end - - - - diff --git a/plugins/MRPT_Utils/mrpt_utils.irp.f b/plugins/MRPT_Utils/mrpt_utils.irp.f index e186116d..dfb8f2c8 100644 --- a/plugins/MRPT_Utils/mrpt_utils.irp.f +++ b/plugins/MRPT_Utils/mrpt_utils.irp.f @@ -16,23 +16,23 @@ integer :: i,j,m integer :: i_state double precision :: accu(N_states) - double precision, allocatable :: delta_ij_tmp(:,:,:) + double precision, allocatable :: delta_ij_local(:,:,:) delta_ij_mrpt = 0.d0 - allocate (delta_ij_tmp(N_det,N_det,N_states)) + allocate (delta_ij_local(N_det,N_det,N_states)) ! 1h - delta_ij_tmp = 0.d0 - call H_apply_mrpt_1h(delta_ij_tmp,N_det) + delta_ij_local = 0.d0 + call H_apply_mrpt_1h(delta_ij_local,N_det) accu = 0.d0 do i_state = 1, N_states do i = 1, N_det do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij_mrpt(j,i,i_state) += delta_ij_tmp(j,i,i_state) + accu(i_state) += delta_ij_local(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij_mrpt(j,i,i_state) += delta_ij_local(j,i,i_state) enddo enddo second_order_pt_new_1h(i_state) = accu(i_state) @@ -40,14 +40,14 @@ print*, '1h = ',accu ! 1p - delta_ij_tmp = 0.d0 - call H_apply_mrpt_1p(delta_ij_tmp,N_det) + delta_ij_local = 0.d0 + call H_apply_mrpt_1p(delta_ij_local,N_det) accu = 0.d0 do i_state = 1, N_states do i = 1, N_det do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij_mrpt(j,i,i_state) += delta_ij_tmp(j,i,i_state) + accu(i_state) += delta_ij_local(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij_mrpt(j,i,i_state) += delta_ij_local(j,i,i_state) enddo enddo second_order_pt_new_1p(i_state) = accu(i_state) @@ -55,15 +55,15 @@ print*, '1p = ',accu ! 1h1p - delta_ij_tmp = 0.d0 - call H_apply_mrpt_1h1p(delta_ij_tmp,N_det) + delta_ij_local = 0.d0 + call H_apply_mrpt_1h1p(delta_ij_local,N_det) double precision :: e_corr_from_1h1p_singles(N_states) accu = 0.d0 do i_state = 1, N_states do i = 1, N_det do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij_mrpt(j,i,i_state) += delta_ij_tmp(j,i,i_state) + accu(i_state) += delta_ij_local(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij_mrpt(j,i,i_state) += delta_ij_local(j,i,i_state) enddo enddo second_order_pt_new_1h1p(i_state) = accu(i_state) @@ -72,14 +72,14 @@ ! 1h1p third order if(do_third_order_1h1p)then - delta_ij_tmp = 0.d0 - call give_1h1p_sec_order_singles_contrib(delta_ij_tmp) + delta_ij_local = 0.d0 + call give_1h1p_sec_order_singles_contrib(delta_ij_local) accu = 0.d0 do i_state = 1, N_states do i = 1, N_det do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij_mrpt(j,i,i_state) += delta_ij_tmp(j,i,i_state) + accu(i_state) += delta_ij_local(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij_mrpt(j,i,i_state) += delta_ij_local(j,i,i_state) enddo enddo second_order_pt_new_1h1p(i_state) = accu(i_state) @@ -88,14 +88,14 @@ endif ! 2h - delta_ij_tmp = 0.d0 - call H_apply_mrpt_2h(delta_ij_tmp,N_det) + delta_ij_local = 0.d0 + call H_apply_mrpt_2h(delta_ij_local,N_det) accu = 0.d0 do i_state = 1, N_states do i = 1, N_det do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij_mrpt(j,i,i_state) += delta_ij_tmp(j,i,i_state) + accu(i_state) += delta_ij_local(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij_mrpt(j,i,i_state) += delta_ij_local(j,i,i_state) enddo enddo second_order_pt_new_2h(i_state) = accu(i_state) @@ -103,14 +103,14 @@ print*, '2h = ',accu ! 2p - delta_ij_tmp = 0.d0 - call H_apply_mrpt_2p(delta_ij_tmp,N_det) + delta_ij_local = 0.d0 + call H_apply_mrpt_2p(delta_ij_local,N_det) accu = 0.d0 do i_state = 1, N_states do i = 1, N_det do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij_mrpt(j,i,i_state) += delta_ij_tmp(j,i,i_state) + accu(i_state) += delta_ij_local(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij_mrpt(j,i,i_state) += delta_ij_local(j,i,i_state) enddo enddo second_order_pt_new_2p(i_state) = accu(i_state) @@ -118,15 +118,15 @@ print*, '2p = ',accu ! 1h2p - delta_ij_tmp = 0.d0 - call give_1h2p_contrib(delta_ij_tmp) - call H_apply_mrpt_1h2p(delta_ij_tmp,N_det) + delta_ij_local = 0.d0 + call give_1h2p_contrib(delta_ij_local) + call H_apply_mrpt_1h2p(delta_ij_local,N_det) accu = 0.d0 do i_state = 1, N_states do i = 1, N_det do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij_mrpt(j,i,i_state) += delta_ij_tmp(j,i,i_state) + accu(i_state) += delta_ij_local(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij_mrpt(j,i,i_state) += delta_ij_local(j,i,i_state) enddo enddo second_order_pt_new_1h2p(i_state) = accu(i_state) @@ -134,15 +134,15 @@ print*, '1h2p = ',accu ! 2h1p - delta_ij_tmp = 0.d0 - call give_2h1p_contrib(delta_ij_tmp) - call H_apply_mrpt_2h1p(delta_ij_tmp,N_det) + delta_ij_local = 0.d0 + call give_2h1p_contrib(delta_ij_local) + call H_apply_mrpt_2h1p(delta_ij_local,N_det) accu = 0.d0 do i_state = 1, N_states do i = 1, N_det do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij_mrpt(j,i,i_state) += delta_ij_tmp(j,i,i_state) + accu(i_state) += delta_ij_local(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij_mrpt(j,i,i_state) += delta_ij_local(j,i,i_state) enddo enddo second_order_pt_new_2h1p(i_state) = accu(i_state) @@ -150,14 +150,14 @@ print*, '2h1p = ',accu ! 2h2p -!delta_ij_tmp = 0.d0 -!call H_apply_mrpt_2h2p(delta_ij_tmp,N_det) +!delta_ij_local = 0.d0 +!call H_apply_mrpt_2h2p(delta_ij_local,N_det) !accu = 0.d0 !do i_state = 1, N_states !do i = 1, N_det ! do j = 1, N_det -! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) -! delta_ij_mrpt(j,i,i_state) += delta_ij_tmp(j,i,i_state) +! accu(i_state) += delta_ij_local(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) +! delta_ij_mrpt(j,i,i_state) += delta_ij_local(j,i,i_state) ! enddo !enddo !second_order_pt_new_2h2p(i_state) = accu(i_state) diff --git a/plugins/dress_zmq/EZFIO.cfg b/plugins/dress_zmq/EZFIO.cfg deleted file mode 100644 index 52d41568..00000000 --- a/plugins/dress_zmq/EZFIO.cfg +++ /dev/null @@ -1,17 +0,0 @@ -[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/dressing_vector.irp.f b/plugins/dress_zmq/dressing_vector.irp.f index 98c69cbf..a7251dd9 100644 --- a/plugins/dress_zmq/dressing_vector.irp.f +++ b/plugins/dress_zmq/dressing_vector.irp.f @@ -18,7 +18,6 @@ do j = 1, n_det dressing_column_h(j,k) = delta_ij(k,j,1) dressing_column_s(j,k) = delta_ij(k,j,2) -! print *, j, delta_ij(k,j,:) enddo enddo END_PROVIDER diff --git a/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES b/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES deleted file mode 100644 index 8416d0f5..00000000 --- a/plugins/mrcc_sto/NEEDED_CHILDREN_MODULES +++ /dev/null @@ -1 +0,0 @@ -dress_zmq DavidsonDressed Psiref_CAS MRPT_Utils Perturbation MRCC_Utils diff --git a/plugins/mrcc_sto/README.rst b/plugins/mrcc_sto/README.rst deleted file mode 100644 index da126dfd..00000000 --- a/plugins/mrcc_sto/README.rst +++ /dev/null @@ -1,12 +0,0 @@ -======== -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 deleted file mode 100644 index e72f1112..00000000 --- a/plugins/mrcc_sto/mrcc_sto.irp.f +++ /dev/null @@ -1,240 +0,0 @@ - -program mrcc_sto - implicit none - BEGIN_DOC -! TODO - END_DOC - call dress_zmq() - call ezfio_set_mrcc_sto_energy(ci_energy_dressed(1)) -end - - - 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, 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 reallocation. -END_DOC -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) - - - integer :: i,j,k,l,m - integer :: degree1, degree2, degree - - double precision :: hIk, hla, hIl, sla, dIk(N_states), dka(N_states), dIa(N_states), hka - double precision :: phase, phase2 - 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 :: Delta_E_inv(N_states) - double precision :: sdress, hdress - logical :: ok, ok2 - integer :: canbediamond - PROVIDE mo_class - - - if(n_minilist == 1) return - - do i=1,n_minilist - if(idx_non_ref_rev(minilist(i)) == 0) return - end do - - 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) - - 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) - if (degree1 > 4) then - cycle - endif - - do i_state=1,N_states - dIa(i_state) = 0.d0 - 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) - 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 - - 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 - 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 - 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_(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 - 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_(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 - 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 - - ok2 = .false. - do i_state=1,N_states - if(dIa(i_state) /= 0d0) ok2 = .true. - enddo - if(.not. ok2) cycle - - 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 - 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 - delta_ij_loc(i_state,k_sd,1) += hdress - !!!$OMP ATOMIC - delta_ij_loc(i_state,k_sd,2) += sdress - enddo - enddo - enddo -end subroutine - - - - - -!! TESTS MINILIST -subroutine test_minilist(minilist, n_minilist, alpha) - use bitmasks - implicit none - 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(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(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 -end subroutine - - diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index ad557d1a..f76a1424 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -74,118 +74,6 @@ 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_cancel, (N_states,N_det_non_ref) ] @@ -251,7 +139,7 @@ END_PROVIDER &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 + integer :: gen, h, p, n, t, i, h1, h2, p1, p2, s1, s2 integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2) integer(bit_kind),allocatable :: buf(:,:,:) logical :: ok @@ -266,13 +154,15 @@ END_PROVIDER delta_ij_s2_mrcc = 0d0 - !$OMP PARALLEL DO default(none) schedule(dynamic) & + !$OMP PARALLEL default(none) & !$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_ij_mrcc, delta_ij_s2_mrcc) & - !$OMP private(h, n, mask, omask, buf, ok, iproc) + !$OMP private(h, n, mask, omask, buf, ok,gen) + + allocate(buf(N_int, 2, N_det_non_ref)) + + !$OMP DO schedule(dynamic) do gen= 1, N_det_generators - allocate(buf(N_int, 2, N_det_non_ref)) - iproc = omp_get_thread_num() + 1 if(mod(gen, 1000) == 0) print *, "mrcc ", 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) @@ -292,9 +182,12 @@ END_PROVIDER endif end do - deallocate(buf) end do - !$OMP END PARALLEL DO + !$OMP END DO + + deallocate(buf) + + !$OMP END PARALLEL END_PROVIDER @@ -502,7 +395,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b 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) @@ -510,7 +403,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b 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 @@ -521,14 +414,14 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b 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 @@ -542,13 +435,13 @@ subroutine mrcc_part_dress(delta_ij_, delta_ij_s2_, i_generator,n_selected,det_b 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) sdress = dIa_sla(i_state,k_sd) * psi_ref_coef(i_I,i_state) - !!$OMP ATOMIC !$OMP ATOMIC - contrib(i_state) += hdress * psi_coef(dressed_column_idx(i_state), i_state) * psi_non_ref_coef(k_sd, i_state) + contrib(i_state) += hdress * psi_non_ref_coef(k_sd, i_state) !$OMP ATOMIC delta_ij_(i_state,k_sd) += hdress !$OMP ATOMIC @@ -596,7 +489,7 @@ END_PROVIDER if(target_error /= 0d0) then target_error = target_error * 0.5d0 ! (-mrcc_E0_denominator(1) + mrcc_previous_E(1)) / 1d1 else - target_error = 1d-4 + target_error = -1d-4 end if call ZMQ_mrcc(E_CI_before, mrcc, delta_ij_mrcc_zmq, delta_ij_s2_mrcc_zmq, abs(target_error)) @@ -609,21 +502,7 @@ END_PROVIDER use bitmasks 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 -! else if(mrmode == 10) then -! do j = 1, N_det_non_ref -! do i_state = 1, N_states -! 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 + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc 5=mrcc_stoch if(mrmode == 5) then do j = 1, N_det_non_ref do i_state = 1, N_states @@ -656,13 +535,6 @@ END_PROVIDER stop "invalid mrmode" end if - !if(mrmode == 2 .or. mrmode == 3) then - ! do j = 1, N_det_non_ref - ! do i_state = 1, N_states - ! delta_ij(i_state,j) += delta_ij_cancel(i_state,j) - ! enddo - ! end do - !end if END_PROVIDER diff --git a/plugins/mrcepa0/dressing_slave.irp.f b/plugins/mrcepa0/dressing_slave.irp.f index b0c3a360..cd635f20 100644 --- a/plugins/mrcepa0/dressing_slave.irp.f +++ b/plugins/mrcepa0/dressing_slave.irp.f @@ -450,15 +450,15 @@ subroutine mrsc2_dressing_collector(zmq_socket_pull,delta_ij_,delta_ij_s2_) do l=1, n(1) do i_state=1,N_states - 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) + delta_ij_(i_state,idx(l,1)) += delta(i_state,l,1) * psi_ref_coef(i_I,i_state) + delta_ij_s2_(i_state,idx(l,1)) += delta_s2(i_state,l,1) * psi_ref_coef(i_I,i_state) end do end do do l=1, n(2) do i_state=1,N_states - 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) + delta_ij_(i_state,idx(l,2)) += delta(i_state,l,2) * psi_ref_coef(J,i_state) + delta_ij_s2_(i_state,idx(l,2)) += delta_s2(i_state,l,2) * psi_ref_coef(J,i_state) end do end do diff --git a/plugins/mrcepa0/dressing_vector.irp.f b/plugins/mrcepa0/dressing_vector.irp.f index 933e57b9..2a2de699 100644 --- a/plugins/mrcepa0/dressing_vector.irp.f +++ b/plugins/mrcepa0/dressing_vector.irp.f @@ -15,17 +15,11 @@ 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) * f - dressing_column_s(j,k) = delta_ij_s2(k,jj) * f + 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 -! stop END_PROVIDER diff --git a/plugins/mrcepa0/mrcc.irp.f b/plugins/mrcepa0/mrcc.irp.f index e0ae3e21..7be35b87 100644 --- a/plugins/mrcepa0/mrcc.irp.f +++ b/plugins/mrcepa0/mrcc.irp.f @@ -7,7 +7,7 @@ program mrsc2sub mrmode = 3 read_wf = .True. - SOFT_TOUCH read_wf + SOFT_TOUCH read_wf call set_generators_bitmasks_as_holes_and_particles if (.True.) then integer :: i,j diff --git a/plugins/mrcepa0/mrcc_omp.irp.f b/plugins/mrcepa0/mrcc_omp.irp.f deleted file mode 100644 index 5c4d318d..00000000 --- a/plugins/mrcepa0/mrcc_omp.irp.f +++ /dev/null @@ -1,27 +0,0 @@ -program mrsc2sub - implicit none - double precision, allocatable :: energy(:) - allocate (energy(N_states)) - - !!mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc - mrmode = 4 - - 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/mrcepa0/mrcc_stoch_routines.irp.f b/plugins/mrcepa0/mrcc_stoch_routines.irp.f index efa7a1ae..abf2734d 100644 --- a/plugins/mrcepa0/mrcc_stoch_routines.irp.f +++ b/plugins/mrcepa0/mrcc_stoch_routines.irp.f @@ -43,6 +43,7 @@ subroutine ZMQ_mrcc(E, mrcc, delta, delta_s2, relative_error) + call write_double(6,relative_error,"Target relative error") print *, '========== ================= ================= =================' print *, ' Samples Energy Stat. Error Seconds ' print *, '========== ================= ================= =================' @@ -335,7 +336,7 @@ subroutine mrcc_collector(zmq_socket_pull, E, relative_error, delta, delta_s2, m print '(I5,F15.7,E12.4,F10.2)', cur_cp, E(mrcc_stoch_istate)+E0+avg, eqt, time-timeInit end if - if (((dabs(eqt)/(E(mrcc_stoch_istate)+E0+avg) < relative_error) .and. cps_N(cur_cp) >= 10) .or. total_computed == N_det_generators) then + if (( (dabs(eqt/(E(mrcc_stoch_istate)+E0+avg)) < relative_error) .and. (cps_N(cur_cp) >= 10) ) .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 @@ -400,7 +401,7 @@ end function &BEGIN_PROVIDER [ integer, N_cps_max ] implicit none comb_teeth = 16 - N_cps_max = 64 + N_cps_max = 128 !comb_per_cp = 64 gen_per_cp = (N_det_generators / N_cps_max) + 1 N_cps_max += 1 diff --git a/plugins/mrcepa0/mrcc_zmq.irp.f b/plugins/mrcepa0/mrcc_zmq.irp.f index f9c519e9..a3089a24 100644 --- a/plugins/mrcepa0/mrcc_zmq.irp.f +++ b/plugins/mrcepa0/mrcc_zmq.irp.f @@ -6,6 +6,10 @@ program mrsc2sub !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc mrmode = 5 +threshold_generators = 1.d0 +threshold_selectors = 1.d0 +TOUCH threshold_generators threshold_selectors + read_wf = .True. SOFT_TOUCH read_wf call set_generators_bitmasks_as_holes_and_particles diff --git a/plugins/read_integral/Gen_Ezfio_from_integral.sh b/plugins/read_integral/Gen_Ezfio_from_integral.sh deleted file mode 100755 index d190ffae..00000000 --- a/plugins/read_integral/Gen_Ezfio_from_integral.sh +++ /dev/null @@ -1,17 +0,0 @@ -#!/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/shiftedbk/EZFIO.cfg b/plugins/shiftedbk/EZFIO.cfg index be4998dd..c594bcf8 100644 --- a/plugins/shiftedbk/EZFIO.cfg +++ b/plugins/shiftedbk/EZFIO.cfg @@ -1,44 +1,23 @@ +[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 -[energy] -type: double precision -doc: Calculated Selected FCI energy -interface: ezfio - -[energy_pt2] -type: double precision -doc: Calculated FCI energy + PT2 -interface: ezfio - -[iterative_save] -type: integer -doc: Save data at each iteration : 1(Append) | 2(Overwrite) | 3(NoSave) -interface: ezfio,ocaml -default: 2 - -[n_iter] -interface: ezfio -doc: number of iterations -type:integer - -[n_det_iter] -interface: ezfio -doc: number of determinants at iteration -type: integer -size: (full_ci_zmq.n_iter) - -[energy_iter] -interface: ezfio -doc: The energy without a pt2 correction for n_det -type: double precision -size: (determinants.n_states,full_ci_zmq.n_iter) - -[pt2_iter] -interface: ezfio -doc: The pt2 correction for n_det -type: double precision -size: (determinants.n_states,full_ci_zmq.n_iter) diff --git a/tests/bats/mrcepa0.bats b/tests/bats/mrcepa0.bats index 4985f8f0..879a85e1 100644 --- a/tests/bats/mrcepa0.bats +++ b/tests/bats/mrcepa0.bats @@ -18,7 +18,25 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set_file TMP energy="$(ezfio get mrcepa0 energy_pt2)" rm -rf TMP - eq $energy -76.2382119593927 1.e-4 + eq $energy -76.2379929298452 1.e-4 +} + +@test "MRCC-stoch H2O cc-pVDZ" { + INPUT=h2o.ezfio + EXE=mrcc_zmq + test_exe $EXE || skip + qp_edit -c $INPUT + ezfio set_file $INPUT + ezfio set determinants threshold_generators 1. + ezfio set determinants threshold_selectors 1. + ezfio set determinants read_wf True + ezfio set mrcepa0 lambda_type 1 + ezfio set mrcepa0 n_it_max_dressed_ci 3 + cp -r $INPUT TMP ; qp_run $EXE TMP + ezfio set_file TMP + energy="$(ezfio get mrcepa0 energy_pt2)" + rm -rf TMP + eq $energy -76.2379929298452 1.e-4 } @test "MRCC H2O cc-pVDZ" { @@ -36,7 +54,25 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set_file TMP energy="$(ezfio get mrcepa0 energy_pt2)" rm -rf TMP - eq $energy -76.2381753982902 1.e-4 + eq $energy -76.2379517543157 1.e-4 +} + +@test "MRCC-stoch H2O cc-pVDZ" { + INPUT=h2o.ezfio + EXE=mrcc_zmq + test_exe $EXE || skip + qp_edit -c $INPUT + ezfio set_file $INPUT + ezfio set determinants threshold_generators 1. + ezfio set determinants threshold_selectors 1. + ezfio set determinants read_wf True + ezfio set mrcepa0 lambda_type 0 + ezfio set mrcepa0 n_it_max_dressed_ci 3 + cp -r $INPUT TMP ; qp_run $EXE TMP + ezfio set_file TMP + energy="$(ezfio get mrcepa0 energy_pt2)" + rm -rf TMP + eq $energy -76.2379517543157 1.e-4 } @test "MRSC2 H2O cc-pVDZ" { @@ -72,6 +108,6 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set_file TMP energy="$(ezfio get mrcepa0 energy_pt2)" rm -rf TMP - eq $energy -76.2411825032868 2.e-4 + eq $energy -76.2407388142333 2.e-4 } diff --git a/tests/bats_to_sh.py b/tests/bats_to_sh.py index 8feb9272..37e5fadb 100755 --- a/tests/bats_to_sh.py +++ b/tests/bats_to_sh.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python2 import sys