mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-24 21:41:46 +02:00
Introduced CASSD ZMQ
This commit is contained in:
parent
b51cfbcfbe
commit
8ef4332406
@ -26,7 +26,7 @@ python:
|
||||
|
||||
script:
|
||||
- ./configure --production ./config/gfortran.cfg
|
||||
- source ./quantum_package.rc ; qp_module.py install Full_CI Full_CI_ZMQ Hartree_Fock CAS_SD mrcepa0 All_singles
|
||||
- source ./quantum_package.rc ; qp_module.py install Full_CI Full_CI_ZMQ Hartree_Fock CAS_SD_ZMQ mrcepa0 All_singles
|
||||
- source ./quantum_package.rc ; ninja
|
||||
- source ./quantum_package.rc ; cd ocaml ; make ; cd -
|
||||
- source ./quantum_package.rc ; cd tests ; ./run_tests.sh #-v
|
||||
|
14
plugins/CAS_SD_ZMQ/README.rst
Normal file
14
plugins/CAS_SD_ZMQ/README.rst
Normal file
@ -0,0 +1,14 @@
|
||||
==========
|
||||
CAS_SD_ZMQ
|
||||
==========
|
||||
|
||||
Selected CAS+SD module with Zero-MQ parallelization.
|
||||
|
||||
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.
|
234
plugins/CAS_SD_ZMQ/cassd_zmq.irp.f
Normal file
234
plugins/CAS_SD_ZMQ/cassd_zmq.irp.f
Normal file
@ -0,0 +1,234 @@
|
||||
program fci_zmq
|
||||
implicit none
|
||||
integer :: i,j,k
|
||||
logical, external :: detEq
|
||||
|
||||
double precision, allocatable :: pt2(:)
|
||||
integer :: degree
|
||||
|
||||
allocate (pt2(N_states))
|
||||
|
||||
pt2 = 1.d0
|
||||
diag_algorithm = "Lapack"
|
||||
|
||||
if (N_det > N_det_max) then
|
||||
call diagonalize_CI
|
||||
call save_wavefunction
|
||||
psi_det = psi_det_sorted
|
||||
psi_coef = psi_coef_sorted
|
||||
N_det = N_det_max
|
||||
soft_touch N_det psi_det psi_coef
|
||||
call diagonalize_CI
|
||||
call save_wavefunction
|
||||
print *, 'N_det = ', N_det
|
||||
print *, 'N_states = ', N_states
|
||||
do k=1,N_states
|
||||
print*,'State ',k
|
||||
print *, 'PT2 = ', pt2(k)
|
||||
print *, 'E = ', CI_energy(k)
|
||||
print *, 'E+PT2 = ', CI_energy(k) + pt2(k)
|
||||
print *, '-----'
|
||||
enddo
|
||||
endif
|
||||
double precision :: E_CI_before(N_states)
|
||||
|
||||
|
||||
integer :: n_det_before
|
||||
print*,'Beginning the selection ...'
|
||||
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||
|
||||
do while ( (N_det < N_det_max) .and. (maxval(abs(pt2(1:N_states))) > pt2_max) )
|
||||
n_det_before = N_det
|
||||
call ZMQ_selection(max(256-N_det, N_det), pt2)
|
||||
|
||||
PROVIDE psi_coef
|
||||
PROVIDE psi_det
|
||||
PROVIDE psi_det_sorted
|
||||
|
||||
call diagonalize_CI
|
||||
call save_wavefunction
|
||||
|
||||
print *, 'N_det = ', N_det
|
||||
print *, 'N_states = ', N_states
|
||||
do k=1, N_states
|
||||
print*,'State ',k
|
||||
print *, 'PT2 = ', pt2(k)
|
||||
print *, 'E = ', CI_energy(k)
|
||||
print *, 'E(before)+PT2 = ', E_CI_before(k)+pt2(k)
|
||||
enddo
|
||||
print *, '-----'
|
||||
if(N_states.gt.1)then
|
||||
print*,'Variational Energy difference'
|
||||
do i = 2, N_states
|
||||
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
||||
enddo
|
||||
endif
|
||||
if(N_states.gt.1)then
|
||||
print*,'Variational + perturbative Energy difference'
|
||||
do i = 2, N_states
|
||||
print*,'Delta E = ',E_CI_before(i)+ pt2(i) - (E_CI_before(1) + pt2(1))
|
||||
enddo
|
||||
endif
|
||||
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||
call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
|
||||
enddo
|
||||
|
||||
integer :: exc_max, degree_min
|
||||
exc_max = 0
|
||||
print *, 'CAS determinants : ', N_det_cas
|
||||
do i=1,min(N_det_cas,10)
|
||||
do k=i,N_det_cas
|
||||
call get_excitation_degree(psi_cas(1,1,k),psi_cas(1,1,i),degree,N_int)
|
||||
exc_max = max(exc_max,degree)
|
||||
enddo
|
||||
print *, psi_cas_coef(i,:)
|
||||
call debug_det(psi_cas(1,1,i),N_int)
|
||||
print *, ''
|
||||
enddo
|
||||
print *, 'Max excitation degree in the CAS :', exc_max
|
||||
|
||||
if(do_pt2_end)then
|
||||
print*,'Last iteration only to compute the PT2'
|
||||
threshold_selectors = max(threshold_selectors,threshold_selectors_pt2)
|
||||
threshold_generators = max(threshold_generators,threshold_generators_pt2)
|
||||
TOUCH threshold_selectors threshold_generators
|
||||
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||
call ZMQ_selection(0, pt2)
|
||||
print *, 'Final step'
|
||||
print *, 'N_det = ', N_det
|
||||
print *, 'N_states = ', N_states
|
||||
do k=1,N_states
|
||||
print *, 'State', k
|
||||
print *, 'PT2 = ', pt2
|
||||
print *, 'E = ', E_CI_before
|
||||
print *, 'E+PT2 = ', E_CI_before+pt2
|
||||
print *, '-----'
|
||||
enddo
|
||||
call ezfio_set_cas_sd_zmq_energy_pt2(E_CI_before+pt2)
|
||||
endif
|
||||
call save_wavefunction
|
||||
call ezfio_set_cas_sd_zmq_energy(CI_energy(1))
|
||||
call ezfio_set_cas_sd_zmq_energy_pt2(E_CI_before+pt2)
|
||||
|
||||
end
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine ZMQ_selection(N_in, pt2)
|
||||
use f77_zmq
|
||||
use selection_types
|
||||
|
||||
implicit none
|
||||
|
||||
character*(512) :: task
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||
integer, intent(in) :: N_in
|
||||
type(selection_buffer) :: b
|
||||
integer :: i, N
|
||||
integer, external :: omp_get_thread_num
|
||||
double precision, intent(out) :: pt2(N_states)
|
||||
|
||||
|
||||
if (.True.) then
|
||||
PROVIDE pt2_e0_denominator
|
||||
N = max(N_in,1)
|
||||
provide nproc
|
||||
call new_parallel_job(zmq_to_qp_run_socket,"selection")
|
||||
call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator))
|
||||
call zmq_set_running(zmq_to_qp_run_socket)
|
||||
call create_selection_buffer(N, N*2, b)
|
||||
endif
|
||||
|
||||
integer :: i_generator, i_generator_start, i_generator_max, step
|
||||
! step = int(max(1.,10*elec_num/mo_tot_num)
|
||||
|
||||
step = int(5000000.d0 / dble(N_int * N_states * elec_num * elec_num * mo_tot_num * mo_tot_num ))
|
||||
step = max(1,step)
|
||||
do i= N_det_generators, 1, -step
|
||||
i_generator_start = max(i-step+1,1)
|
||||
i_generator_max = i
|
||||
write(task,*) i_generator_start, i_generator_max, 1, N
|
||||
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
||||
end do
|
||||
|
||||
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
|
||||
i = omp_get_thread_num()
|
||||
if (i==0) then
|
||||
call selection_collector(b, pt2)
|
||||
else
|
||||
call selection_slave_inproc(i)
|
||||
endif
|
||||
!$OMP END PARALLEL
|
||||
call end_parallel_job(zmq_to_qp_run_socket, 'selection')
|
||||
if (N_in > 0) then
|
||||
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) !!! PAS DE ROBIN
|
||||
call copy_H_apply_buffer_to_wf()
|
||||
if (s2_eig) then
|
||||
call make_s2_eigenfunction
|
||||
endif
|
||||
endif
|
||||
end subroutine
|
||||
|
||||
|
||||
subroutine selection_slave_inproc(i)
|
||||
implicit none
|
||||
integer, intent(in) :: i
|
||||
|
||||
call run_selection_slave(1,i,pt2_e0_denominator)
|
||||
end
|
||||
|
||||
subroutine selection_collector(b, pt2)
|
||||
use f77_zmq
|
||||
use selection_types
|
||||
use bitmasks
|
||||
implicit none
|
||||
|
||||
|
||||
type(selection_buffer), intent(inout) :: b
|
||||
double precision, intent(out) :: pt2(N_states)
|
||||
double precision :: pt2_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(ZMQ_PTR) :: zmq_socket_pull
|
||||
|
||||
integer :: msg_size, rc, more
|
||||
integer :: acc, i, j, robin, N, ntask
|
||||
double precision, allocatable :: val(:)
|
||||
integer(bit_kind), allocatable :: det(:,:,:)
|
||||
integer, allocatable :: task_id(:)
|
||||
integer :: done
|
||||
real :: time, time0
|
||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||
zmq_socket_pull = new_zmq_pull_socket()
|
||||
allocate(val(b%N), det(N_int, 2, b%N), task_id(N_det))
|
||||
done = 0
|
||||
more = 1
|
||||
pt2(:) = 0d0
|
||||
call CPU_TIME(time0)
|
||||
do while (more == 1)
|
||||
call pull_selection_results(zmq_socket_pull, pt2_mwen, val(1), det(1,1,1), N, task_id, ntask)
|
||||
pt2 += pt2_mwen
|
||||
do i=1, N
|
||||
call add_to_selection_buffer(b, det(1,1,i), val(i))
|
||||
end do
|
||||
|
||||
do i=1, ntask
|
||||
if(task_id(i) == 0) then
|
||||
print *, "Error in collector"
|
||||
endif
|
||||
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more)
|
||||
end do
|
||||
done += ntask
|
||||
call CPU_TIME(time)
|
||||
! print *, "DONE" , done, time - time0
|
||||
end do
|
||||
|
||||
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
call end_zmq_pull_socket(zmq_socket_pull)
|
||||
call sort_selection_buffer(b)
|
||||
end subroutine
|
||||
|
79
plugins/CAS_SD_ZMQ/e_corr_selectors.irp.f
Normal file
79
plugins/CAS_SD_ZMQ/e_corr_selectors.irp.f
Normal file
@ -0,0 +1,79 @@
|
||||
|
||||
use bitmasks
|
||||
BEGIN_PROVIDER [integer, exc_degree_per_selectors, (N_det_selectors)]
|
||||
&BEGIN_PROVIDER [integer, double_index_selectors, (N_det_selectors)]
|
||||
&BEGIN_PROVIDER [integer, n_double_selectors]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! degree of excitation respect to Hartree Fock for the wave function
|
||||
!
|
||||
! for the all the selectors determinants
|
||||
!
|
||||
! double_index_selectors = list of the index of the double excitations
|
||||
!
|
||||
! n_double_selectors = number of double excitations in the selectors determinants
|
||||
END_DOC
|
||||
integer :: i,degree
|
||||
n_double_selectors = 0
|
||||
do i = 1, N_det_selectors
|
||||
call get_excitation_degree(psi_selectors(1,1,i),ref_bitmask,degree,N_int)
|
||||
exc_degree_per_selectors(i) = degree
|
||||
if(degree==2)then
|
||||
n_double_selectors += 1
|
||||
double_index_selectors(n_double_selectors) =i
|
||||
endif
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER[double precision, coef_hf_selector]
|
||||
&BEGIN_PROVIDER[double precision, inv_selectors_coef_hf]
|
||||
&BEGIN_PROVIDER[double precision, inv_selectors_coef_hf_squared]
|
||||
&BEGIN_PROVIDER[double precision, E_corr_per_selectors, (N_det_selectors)]
|
||||
&BEGIN_PROVIDER[double precision, i_H_HF_per_selectors, (N_det_selectors)]
|
||||
&BEGIN_PROVIDER[double precision, Delta_E_per_selector, (N_det_selectors)]
|
||||
&BEGIN_PROVIDER[double precision, E_corr_double_only ]
|
||||
&BEGIN_PROVIDER[double precision, E_corr_second_order ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! energy of correlation per determinant respect to the Hartree Fock determinant
|
||||
!
|
||||
! for the all the double excitations in the selectors determinants
|
||||
!
|
||||
! E_corr_per_selectors(i) = <D_i|H|HF> * c(D_i)/c(HF) if |D_i> is a double excitation
|
||||
!
|
||||
! E_corr_per_selectors(i) = -1000.d0 if it is not a double excitation
|
||||
!
|
||||
! coef_hf_selector = coefficient of the Hartree Fock determinant in the selectors determinants
|
||||
END_DOC
|
||||
PROVIDE ref_bitmask_energy psi_selectors ref_bitmask N_int psi_selectors
|
||||
integer :: i,degree
|
||||
double precision :: hij,diag_H_mat_elem
|
||||
E_corr_double_only = 0.d0
|
||||
E_corr_second_order = 0.d0
|
||||
do i = 1, N_det_selectors
|
||||
if(exc_degree_per_selectors(i)==2)then
|
||||
call i_H_j(ref_bitmask,psi_selectors(1,1,i),N_int,hij)
|
||||
i_H_HF_per_selectors(i) = hij
|
||||
E_corr_per_selectors(i) = psi_selectors_coef(i,1) * hij
|
||||
E_corr_double_only += E_corr_per_selectors(i)
|
||||
! E_corr_second_order += hij * hij /(ref_bitmask_energy - diag_H_mat_elem(psi_selectors(1,1,i),N_int))
|
||||
elseif(exc_degree_per_selectors(i) == 0)then
|
||||
coef_hf_selector = psi_selectors_coef(i,1)
|
||||
E_corr_per_selectors(i) = -1000.d0
|
||||
Delta_E_per_selector(i) = 0.d0
|
||||
else
|
||||
E_corr_per_selectors(i) = -1000.d0
|
||||
endif
|
||||
enddo
|
||||
if (dabs(coef_hf_selector) > 1.d-8) then
|
||||
inv_selectors_coef_hf = 1.d0/coef_hf_selector
|
||||
inv_selectors_coef_hf_squared = inv_selectors_coef_hf * inv_selectors_coef_hf
|
||||
else
|
||||
inv_selectors_coef_hf = 0.d0
|
||||
inv_selectors_coef_hf_squared = 0.d0
|
||||
endif
|
||||
do i = 1,n_double_selectors
|
||||
E_corr_per_selectors(double_index_selectors(i)) *=inv_selectors_coef_hf
|
||||
enddo
|
||||
E_corr_double_only = E_corr_double_only * inv_selectors_coef_hf
|
||||
END_PROVIDER
|
11
plugins/CAS_SD_ZMQ/energy.irp.f
Normal file
11
plugins/CAS_SD_ZMQ/energy.irp.f
Normal file
@ -0,0 +1,11 @@
|
||||
BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! E0 in the denominator of the PT2
|
||||
END_DOC
|
||||
pt2_E0_denominator(:) = CI_electronic_energy(:)
|
||||
! pt2_E0_denominator(:) = HF_energy - nuclear_repulsion
|
||||
! pt2_E0_denominator(:) = barycentric_electronic_energy(:)
|
||||
call write_double(6,pt2_E0_denominator(1)+nuclear_repulsion, 'PT2 Energy denominator')
|
||||
END_PROVIDER
|
||||
|
4
plugins/CAS_SD_ZMQ/ezfio_interface.irp.f
Normal file
4
plugins/CAS_SD_ZMQ/ezfio_interface.irp.f
Normal file
@ -0,0 +1,4 @@
|
||||
! DO NOT MODIFY BY HAND
|
||||
! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py
|
||||
! from file /home/scemama/quantum_package/src/CAS_SD_ZMQ/EZFIO.cfg
|
||||
|
156
plugins/CAS_SD_ZMQ/run_selection_slave.irp.f
Normal file
156
plugins/CAS_SD_ZMQ/run_selection_slave.irp.f
Normal file
@ -0,0 +1,156 @@
|
||||
|
||||
subroutine run_selection_slave(thread,iproc,energy)
|
||||
use f77_zmq
|
||||
use selection_types
|
||||
implicit none
|
||||
|
||||
double precision, intent(in) :: energy(N_states_diag)
|
||||
integer, intent(in) :: thread, iproc
|
||||
integer :: rc, i
|
||||
|
||||
integer :: worker_id, task_id(1), 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
|
||||
|
||||
type(selection_buffer) :: buf, buf2
|
||||
logical :: done
|
||||
double precision :: pt2(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 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)
|
||||
return
|
||||
end if
|
||||
buf%N = 0
|
||||
ctask = 1
|
||||
pt2 = 0d0
|
||||
|
||||
do
|
||||
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id(ctask), task)
|
||||
done = task_id(ctask) == 0
|
||||
if (done) then
|
||||
ctask = ctask - 1
|
||||
else
|
||||
integer :: i_generator, i_generator_start, i_generator_max, step, N
|
||||
read (task,*) i_generator_start, i_generator_max, step, N
|
||||
if(buf%N == 0) then
|
||||
! Only first time
|
||||
call create_selection_buffer(N, N*2, buf)
|
||||
call create_selection_buffer(N, N*3, buf2)
|
||||
else
|
||||
if(N /= buf%N) stop "N changed... wtf man??"
|
||||
end if
|
||||
!print *, "psi_selectors_coef ", psi_selectors_coef(N_det_selectors-5:N_det_selectors, 1)
|
||||
!call debug_det(psi_selectors(1,1,N_det_selectors), N_int)
|
||||
do i_generator=i_generator_start,i_generator_max,step
|
||||
call select_connected(i_generator,energy,pt2,buf)
|
||||
enddo
|
||||
endif
|
||||
|
||||
if(done .or. ctask == size(task_id)) then
|
||||
if(buf%N == 0 .and. ctask > 0) stop "uninitialized selection_buffer"
|
||||
do i=1, ctask
|
||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i))
|
||||
end do
|
||||
if(ctask > 0) then
|
||||
call push_selection_results(zmq_socket_push, pt2, buf, task_id(1), ctask)
|
||||
do i=1,buf%cur
|
||||
call add_to_selection_buffer(buf2, buf%det(1,1,i), buf%val(i))
|
||||
enddo
|
||||
call sort_selection_buffer(buf2)
|
||||
buf%mini = buf2%mini
|
||||
pt2 = 0d0
|
||||
buf%cur = 0
|
||||
end if
|
||||
ctask = 0
|
||||
end if
|
||||
|
||||
if(done) exit
|
||||
ctask = ctask + 1
|
||||
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_selection_results(zmq_socket_push, pt2, b, task_id, ntask)
|
||||
use f77_zmq
|
||||
use selection_types
|
||||
implicit none
|
||||
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
|
||||
double precision, intent(in) :: pt2(N_states)
|
||||
type(selection_buffer), intent(inout) :: b
|
||||
integer, intent(in) :: ntask, task_id(*)
|
||||
integer :: rc
|
||||
|
||||
call sort_selection_buffer(b)
|
||||
|
||||
rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)
|
||||
if(rc /= 4) stop "push"
|
||||
rc = f77_zmq_send( zmq_socket_push, pt2, 8*N_states, ZMQ_SNDMORE)
|
||||
if(rc /= 8*N_states) stop "push"
|
||||
|
||||
rc = f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE)
|
||||
if(rc /= 8*b%cur) stop "push"
|
||||
|
||||
rc = f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE)
|
||||
if(rc /= bit_kind*N_int*2*b%cur) stop "push"
|
||||
|
||||
rc = f77_zmq_send( zmq_socket_push, ntask, 4, ZMQ_SNDMORE)
|
||||
if(rc /= 4) stop "push"
|
||||
|
||||
rc = f77_zmq_send( zmq_socket_push, task_id(1), ntask*4, 0)
|
||||
if(rc /= 4*ntask) stop "push"
|
||||
|
||||
! Activate is zmq_socket_push is a REQ
|
||||
! rc = f77_zmq_recv( zmq_socket_push, task_id(1), ntask*4, 0)
|
||||
end subroutine
|
||||
|
||||
|
||||
subroutine pull_selection_results(zmq_socket_pull, pt2, val, det, N, task_id, ntask)
|
||||
use f77_zmq
|
||||
use selection_types
|
||||
implicit none
|
||||
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
|
||||
double precision, intent(inout) :: pt2(N_states)
|
||||
double precision, intent(out) :: val(*)
|
||||
integer(bit_kind), intent(out) :: det(N_int, 2, *)
|
||||
integer, intent(out) :: N, ntask, task_id(*)
|
||||
integer :: rc, rn, i
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0)
|
||||
if(rc /= 4) stop "pull"
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, pt2, N_states*8, 0)
|
||||
if(rc /= 8*N_states) stop "pull"
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0)
|
||||
if(rc /= 8*N) stop "pull"
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0)
|
||||
if(rc /= bit_kind*N_int*2*N) stop "pull"
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, 0)
|
||||
if(rc /= 4) stop "pull"
|
||||
|
||||
rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntask*4, 0)
|
||||
if(rc /= 4*ntask) stop "pull"
|
||||
|
||||
! Activate is zmq_socket_pull is a REP
|
||||
! rc = f77_zmq_send( zmq_socket_pull, task_id(1), ntask*4, 0)
|
||||
end subroutine
|
||||
|
||||
|
||||
|
1202
plugins/CAS_SD_ZMQ/selection.irp.f
Normal file
1202
plugins/CAS_SD_ZMQ/selection.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
70
plugins/CAS_SD_ZMQ/selection_buffer.irp.f
Normal file
70
plugins/CAS_SD_ZMQ/selection_buffer.irp.f
Normal file
@ -0,0 +1,70 @@
|
||||
|
||||
subroutine create_selection_buffer(N, siz, res)
|
||||
use selection_types
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: N, siz
|
||||
type(selection_buffer), intent(out) :: res
|
||||
|
||||
allocate(res%det(N_int, 2, siz), res%val(siz))
|
||||
|
||||
res%val = 0d0
|
||||
res%det = 0_8
|
||||
res%N = N
|
||||
res%mini = 0d0
|
||||
res%cur = 0
|
||||
end subroutine
|
||||
|
||||
|
||||
subroutine add_to_selection_buffer(b, det, val)
|
||||
use selection_types
|
||||
implicit none
|
||||
|
||||
type(selection_buffer), intent(inout) :: b
|
||||
integer(bit_kind), intent(in) :: det(N_int, 2)
|
||||
double precision, intent(in) :: val
|
||||
integer :: i
|
||||
|
||||
if(dabs(val) >= b%mini) then
|
||||
b%cur += 1
|
||||
b%det(:,:,b%cur) = det(:,:)
|
||||
b%val(b%cur) = val
|
||||
if(b%cur == size(b%val)) then
|
||||
call sort_selection_buffer(b)
|
||||
end if
|
||||
end if
|
||||
end subroutine
|
||||
|
||||
|
||||
subroutine sort_selection_buffer(b)
|
||||
use selection_types
|
||||
implicit none
|
||||
|
||||
type(selection_buffer), intent(inout) :: b
|
||||
double precision, allocatable :: vals(:), absval(:)
|
||||
integer, allocatable :: iorder(:)
|
||||
integer(bit_kind), allocatable :: detmp(:,:,:)
|
||||
integer :: i, nmwen
|
||||
logical, external :: detEq
|
||||
nmwen = min(b%N, b%cur)
|
||||
|
||||
|
||||
allocate(iorder(b%cur), detmp(N_int, 2, nmwen), absval(b%cur), vals(nmwen))
|
||||
absval = -dabs(b%val(:b%cur))
|
||||
do i=1,b%cur
|
||||
iorder(i) = i
|
||||
end do
|
||||
call dsort(absval, iorder, b%cur)
|
||||
|
||||
do i=1, nmwen
|
||||
detmp(:,:,i) = b%det(:,:,iorder(i))
|
||||
vals(i) = b%val(iorder(i))
|
||||
end do
|
||||
b%det(:,:,:nmwen) = detmp(:,:,:)
|
||||
b%det(:,:,nmwen+1:) = 0_bit_kind
|
||||
b%val(:nmwen) = vals(:)
|
||||
b%val(nmwen+1:) = 0d0
|
||||
b%mini = max(b%mini,dabs(b%val(b%N)))
|
||||
b%cur = nmwen
|
||||
end subroutine
|
||||
|
9
plugins/CAS_SD_ZMQ/selection_types.f90
Normal file
9
plugins/CAS_SD_ZMQ/selection_types.f90
Normal file
@ -0,0 +1,9 @@
|
||||
module selection_types
|
||||
type selection_buffer
|
||||
integer :: N, cur
|
||||
integer(8), allocatable :: det(:,:,:)
|
||||
double precision, allocatable :: val(:)
|
||||
double precision :: mini
|
||||
endtype
|
||||
end module
|
||||
|
@ -1 +1 @@
|
||||
Perturbation Selectors_full Generators_full ZMQ Full_CI
|
||||
Perturbation Selectors_full Generators_full ZMQ
|
||||
|
@ -79,7 +79,7 @@ program fci_zmq
|
||||
enddo
|
||||
endif
|
||||
E_CI_before(1:N_states) = CI_energy(1:N_states)
|
||||
call ezfio_set_full_ci_energy(CI_energy)
|
||||
call ezfio_set_full_ci_zmq_energy(CI_energy)
|
||||
enddo
|
||||
|
||||
if(do_pt2_end)then
|
||||
@ -99,7 +99,7 @@ program fci_zmq
|
||||
print *, 'E+PT2 = ', E_CI_before+pt2
|
||||
print *, '-----'
|
||||
enddo
|
||||
call ezfio_set_full_ci_energy_pt2(E_CI_before+pt2)
|
||||
call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before+pt2)
|
||||
endif
|
||||
call save_wavefunction
|
||||
end
|
||||
|
@ -350,8 +350,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
|
||||
integral = ao_bielec_integral(1,1,1,1)
|
||||
|
||||
real :: map_mb
|
||||
print*, 'read_ao_integrals',read_ao_integrals
|
||||
print*, 'disk_access_ao_integrals',disk_access_ao_integrals
|
||||
PROVIDE read_ao_integrals disk_access_ao_integrals
|
||||
if (read_ao_integrals) then
|
||||
print*,'Reading the AO integrals'
|
||||
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
|
||||
|
@ -3,15 +3,15 @@
|
||||
source $QP_ROOT/tests/bats/common.bats.sh
|
||||
|
||||
@test "CAS_SD H2O cc-pVDZ" {
|
||||
test_exe cas_sd_selected || skip
|
||||
test_exe cassd_zmq || skip
|
||||
INPUT=h2o.ezfio
|
||||
qp_edit -c $INPUT
|
||||
ezfio set_file $INPUT
|
||||
ezfio set perturbation do_pt2_end False
|
||||
ezfio set determinants n_det_max 1000
|
||||
ezfio set determinants n_det_max 2000
|
||||
qp_set_mo_class $INPUT -core "[1]" -inact "[2,5]" -act "[3,4,6,7]" -virt "[8-24]"
|
||||
qp_run cas_sd_selected $INPUT
|
||||
energy="$(ezfio get cas_sd energy)"
|
||||
qp_run cassd_zmq $INPUT
|
||||
energy="$(ezfio get cas_sd_zmq energy)"
|
||||
eq $energy -76.2221842108163 1.E-5
|
||||
}
|
||||
|
||||
|
@ -20,7 +20,7 @@ function run_FCI() {
|
||||
|
||||
function run_FCI_ZMQ() {
|
||||
thresh=5.e-5
|
||||
test_exe full_ci || skip
|
||||
test_exe fci_zmq || skip
|
||||
qp_edit -c $1
|
||||
ezfio set_file $1
|
||||
ezfio set perturbation do_pt2_end True
|
||||
@ -28,9 +28,9 @@ function run_FCI_ZMQ() {
|
||||
ezfio set davidson threshold_davidson 1.e-10
|
||||
|
||||
qp_run fci_zmq $1
|
||||
energy="$(ezfio get full_ci energy)"
|
||||
energy="$(ezfio get full_ci_zmq energy)"
|
||||
eq $energy $3 $thresh
|
||||
energy_pt2="$(ezfio get full_ci energy_pt2)"
|
||||
energy_pt2="$(ezfio get full_ci_zmq energy_pt2)"
|
||||
eq $energy_pt2 $4 $thresh
|
||||
}
|
||||
|
||||
|
@ -23,7 +23,7 @@ function run_HF() {
|
||||
|
||||
function run_FCI_ZMQ() {
|
||||
thresh=5.e-5
|
||||
test_exe full_ci || skip
|
||||
test_exe fci_zmq|| skip
|
||||
qp_edit -c $1
|
||||
ezfio set_file $1
|
||||
ezfio set perturbation do_pt2_end True
|
||||
@ -31,9 +31,9 @@ function run_FCI_ZMQ() {
|
||||
ezfio set davidson threshold_davidson 1.e-10
|
||||
|
||||
qp_run fci_zmq $1
|
||||
energy="$(ezfio get full_ci energy)"
|
||||
energy="$(ezfio get full_ci_zmq energy)"
|
||||
eq $energy $3 $thresh
|
||||
energy_pt2="$(ezfio get full_ci energy_pt2)"
|
||||
energy_pt2="$(ezfio get full_ci_zmq energy_pt2)"
|
||||
eq $energy_pt2 $4 $thresh
|
||||
}
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user