mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-23 03:53:29 +01:00
working on complex cipsi
This commit is contained in:
Kevin Gasperich
parent
20d5bcd9d5
commit
17b9b423a9
@ -33,7 +33,11 @@ subroutine run_cipsi
|
||||
if (s2_eig) then
|
||||
call make_s2_eigenfunction
|
||||
endif
|
||||
if (is_complex) then
|
||||
call diagonalize_CI_complex
|
||||
else
|
||||
call diagonalize_CI
|
||||
endif
|
||||
call save_wavefunction
|
||||
|
||||
call ezfio_has_hartree_fock_energy(has)
|
||||
@ -57,7 +61,11 @@ subroutine run_cipsi
|
||||
if (s2_eig) then
|
||||
call make_s2_eigenfunction
|
||||
endif
|
||||
call diagonalize_ci
|
||||
if (is_complex) then
|
||||
call diagonalize_CI_complex
|
||||
else
|
||||
call diagonalize_CI
|
||||
endif
|
||||
call save_wavefunction
|
||||
endif
|
||||
|
||||
@ -86,8 +94,13 @@ subroutine run_cipsi
|
||||
norm = 0.d0
|
||||
threshold_generators = 1.d0
|
||||
SOFT_TOUCH threshold_generators
|
||||
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
|
||||
if (is_complex) then
|
||||
call zmq_pt2_complex(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
|
||||
norm, 0) ! Stochastic PT2
|
||||
else
|
||||
call zmq_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
|
||||
norm, 0) ! Stochastic PT2
|
||||
endif
|
||||
threshold_generators = threshold_generators_save
|
||||
SOFT_TOUCH threshold_generators
|
||||
endif
|
||||
@ -114,16 +127,21 @@ subroutine run_cipsi
|
||||
n_det_before = N_det
|
||||
to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor)
|
||||
to_select = max(N_states_diag, to_select)
|
||||
call ZMQ_selection(to_select, pt2, variance, norm)
|
||||
if (is_complex) then
|
||||
call zmq_selection_complex(to_select, pt2, variance, norm)
|
||||
PROVIDE psi_coef_complex
|
||||
else
|
||||
call zmq_selection(to_select, pt2, variance, norm)
|
||||
PROVIDE psi_coef
|
||||
endif
|
||||
PROVIDE psi_det
|
||||
PROVIDE psi_det_sorted
|
||||
|
||||
if (is_complex) then
|
||||
call diagonalize_ci_complex
|
||||
else
|
||||
call diagonalize_CI
|
||||
endif
|
||||
call save_wavefunction
|
||||
call save_energy(psi_energy_with_nucl_rep, zeros)
|
||||
if (qp_stop()) exit
|
||||
@ -135,7 +153,11 @@ print *, (correlation_energy_ratio <= correlation_energy_ratio_max)
|
||||
|
||||
if (.not.qp_stop()) then
|
||||
if (N_det < N_det_max) then
|
||||
if (is_complex) then
|
||||
call diagonalize_ci_complex
|
||||
else
|
||||
call diagonalize_CI
|
||||
endif
|
||||
call save_wavefunction
|
||||
call save_energy(psi_energy_with_nucl_rep, zeros)
|
||||
endif
|
||||
@ -146,8 +168,13 @@ print *, (correlation_energy_ratio <= correlation_energy_ratio_max)
|
||||
norm(:) = 0.d0
|
||||
threshold_generators = 1d0
|
||||
SOFT_TOUCH threshold_generators
|
||||
if (is_complex) then
|
||||
call zmq_pt2_complex(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, &
|
||||
norm,0) ! Stochastic PT2
|
||||
else
|
||||
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, &
|
||||
norm,0) ! Stochastic PT2
|
||||
endif
|
||||
SOFT_TOUCH threshold_generators
|
||||
endif
|
||||
print *, 'N_det = ', N_det
|
||||
|
||||
@ -815,4 +815,249 @@ END_PROVIDER
|
||||
|
||||
|
||||
|
||||
!==============================================================================!
|
||||
! !
|
||||
! Complex !
|
||||
! !
|
||||
!==============================================================================!
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine ZMQ_pt2_complex(E, pt2,relative_error, error, variance, norm, N_in)
|
||||
!todo: implement for complex
|
||||
print*,irp_here
|
||||
stop -1
|
||||
use f77_zmq
|
||||
use selection_types
|
||||
|
||||
implicit none
|
||||
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
|
||||
integer, intent(in) :: N_in
|
||||
double precision, intent(in) :: relative_error, E(N_states)
|
||||
double precision, intent(out) :: pt2(N_states),error(N_states)
|
||||
double precision, intent(out) :: variance(N_states),norm(N_states)
|
||||
|
||||
|
||||
integer :: i, N
|
||||
|
||||
double precision :: state_average_weight_save(N_states), w(N_states,4)
|
||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||
type(selection_buffer) :: b
|
||||
|
||||
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 psi_selectors_coef_transp_complex psi_det_sorted
|
||||
PROVIDE psi_det_hii selection_weight pseudo_sym
|
||||
|
||||
if (h0_type == 'SOP') then
|
||||
PROVIDE psi_occ_pattern_hii det_to_occ_pattern
|
||||
endif
|
||||
|
||||
if (N_det <= max(4,N_states)) then
|
||||
pt2=0.d0
|
||||
variance=0.d0
|
||||
norm=0.d0
|
||||
call zmq_selection_complex(N_in, pt2, variance, norm)
|
||||
error(:) = 0.d0
|
||||
else
|
||||
|
||||
N = max(N_in,1) * N_states
|
||||
state_average_weight_save(:) = state_average_weight(:)
|
||||
if (int(N,8)*2_8 > huge(1)) then
|
||||
print *, irp_here, ': integer too large'
|
||||
stop -1
|
||||
endif
|
||||
call create_selection_buffer(N, N*2, b)
|
||||
ASSERT (associated(b%det))
|
||||
ASSERT (associated(b%val))
|
||||
|
||||
do pt2_stoch_istate=1,N_states
|
||||
state_average_weight(:) = 0.d0
|
||||
state_average_weight(pt2_stoch_istate) = 1.d0
|
||||
TOUCH state_average_weight pt2_stoch_istate selection_weight
|
||||
|
||||
PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w
|
||||
PROVIDE psi_selectors pt2_u pt2_J pt2_R
|
||||
call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
|
||||
|
||||
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_put_ivector
|
||||
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',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then
|
||||
stop 'Unable to put energy on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then
|
||||
stop 'Unable to put state_average_weight on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then
|
||||
stop 'Unable to put selection_weight on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then
|
||||
stop 'Unable to put pt2_stoch_istate on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then
|
||||
stop 'Unable to put threshold_generators on ZMQ server'
|
||||
endif
|
||||
|
||||
|
||||
integer, external :: add_task_to_taskserver
|
||||
character(300000) :: task
|
||||
|
||||
integer :: j,k,ipos,ifirst
|
||||
ifirst=0
|
||||
|
||||
ipos=0
|
||||
do i=1,N_det_generators
|
||||
if (pt2_F(i) > 1) then
|
||||
ipos += 1
|
||||
endif
|
||||
enddo
|
||||
call write_int(6,sum(pt2_F),'Number of tasks')
|
||||
call write_int(6,ipos,'Number of fragmented tasks')
|
||||
|
||||
ipos=1
|
||||
do i= 1, N_det_generators
|
||||
do j=1,pt2_F(pt2_J(i))
|
||||
write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in
|
||||
ipos += 30
|
||||
if (ipos > 300000-30) 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
|
||||
if (ifirst == 0) then
|
||||
ifirst=1
|
||||
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||
print *, irp_here, ': Failed in zmq_set_running'
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
end do
|
||||
enddo
|
||||
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
|
||||
|
||||
integer, external :: zmq_set_running
|
||||
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||
print *, irp_here, ': Failed in zmq_set_running'
|
||||
endif
|
||||
|
||||
|
||||
double precision :: mem_collector, mem, rss
|
||||
|
||||
call resident_memory(rss)
|
||||
|
||||
mem_collector = 8.d0 * & ! bytes
|
||||
( 1.d0*pt2_n_tasks_max & ! task_id, index
|
||||
+ 0.635d0*N_det_generators & ! f,d
|
||||
+ 3.d0*N_det_generators*N_states & ! eI, vI, nI
|
||||
+ 3.d0*pt2_n_tasks_max*N_states & ! eI_task, vI_task, nI_task
|
||||
+ 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3
|
||||
+ 1.d0*(N_int*2.d0*N + N) & ! selection buffer
|
||||
+ 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer
|
||||
) / 1024.d0**3
|
||||
|
||||
integer :: nproc_target, ii
|
||||
nproc_target = nthreads_pt2
|
||||
ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2)
|
||||
|
||||
do
|
||||
mem = mem_collector + & !
|
||||
nproc_target * 8.d0 * & ! bytes
|
||||
( 0.5d0*pt2_n_tasks_max & ! task_id
|
||||
+ 64.d0*pt2_n_tasks_max & ! task
|
||||
+ 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm
|
||||
+ 1.d0*pt2_n_tasks_max & ! i_generator, subset
|
||||
+ 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer
|
||||
+ 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer
|
||||
+ 2.0d0*(ii) & ! preinteresting, interesting,
|
||||
! prefullinteresting, fullinteresting
|
||||
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
||||
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
|
||||
) / 1024.d0**3
|
||||
|
||||
if (nproc_target == 0) then
|
||||
call check_mem(mem,irp_here)
|
||||
nproc_target = 1
|
||||
exit
|
||||
endif
|
||||
|
||||
if (mem+rss < qp_max_mem) then
|
||||
exit
|
||||
endif
|
||||
|
||||
nproc_target = nproc_target - 1
|
||||
|
||||
enddo
|
||||
call write_int(6,nproc_target,'Number of threads for PT2')
|
||||
call write_double(6,mem,'Memory (Gb)')
|
||||
|
||||
call omp_set_nested(.false.)
|
||||
|
||||
|
||||
print '(A)', '========== ================= =========== =============== =============== ================='
|
||||
print '(A)', ' Samples Energy Stat. Err Variance Norm Seconds '
|
||||
print '(A)', '========== ================= =========== =============== =============== ================='
|
||||
|
||||
PROVIDE global_selection_buffer
|
||||
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) &
|
||||
!$OMP PRIVATE(i)
|
||||
i = omp_get_thread_num()
|
||||
if (i==0) then
|
||||
|
||||
call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, w(1,1), w(1,2), w(1,3), w(1,4), b, N)
|
||||
pt2(pt2_stoch_istate) = w(pt2_stoch_istate,1)
|
||||
error(pt2_stoch_istate) = w(pt2_stoch_istate,2)
|
||||
variance(pt2_stoch_istate) = w(pt2_stoch_istate,3)
|
||||
norm(pt2_stoch_istate) = w(pt2_stoch_istate,4)
|
||||
|
||||
else
|
||||
call pt2_slave_inproc(i)
|
||||
endif
|
||||
!$OMP END PARALLEL
|
||||
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
|
||||
|
||||
print '(A)', '========== ================= =========== =============== =============== ================='
|
||||
|
||||
enddo
|
||||
FREE pt2_stoch_istate
|
||||
|
||||
if (N_in > 0) then
|
||||
b%cur = min(N_in,b%cur)
|
||||
if (s2_eig) then
|
||||
call make_selection_buffer_s2(b)
|
||||
else
|
||||
call remove_duplicates_in_selection_buffer(b)
|
||||
endif
|
||||
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0)
|
||||
endif
|
||||
call delete_selection_buffer(b)
|
||||
|
||||
state_average_weight(:) = state_average_weight_save(:)
|
||||
TOUCH state_average_weight
|
||||
endif
|
||||
do k=N_det+1,N_states
|
||||
pt2(k) = 0.d0
|
||||
enddo
|
||||
|
||||
call update_pt2_and_variance_weights(pt2, variance, norm, N_states)
|
||||
|
||||
end subroutine
|
||||
|
||||
|
||||
@ -26,7 +26,11 @@ subroutine run_selection_slave(thread,iproc,energy)
|
||||
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 N_int pt2_F pseudo_sym
|
||||
if (is_complex) then
|
||||
PROVIDE psi_selectors_coef_transp_complex psi_det_sorted weight_selection
|
||||
else
|
||||
PROVIDE psi_selectors_coef_transp psi_det_sorted weight_selection
|
||||
endif
|
||||
|
||||
|
||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||
|
||||
@ -173,6 +173,7 @@ end subroutine
|
||||
|
||||
|
||||
subroutine select_connected(i_generator,E0,pt2,variance,norm,b,subset,csubset)
|
||||
!todo: simplify for kpts
|
||||
use bitmasks
|
||||
use selection_types
|
||||
implicit none
|
||||
@ -275,9 +276,11 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
||||
integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :)
|
||||
logical, allocatable :: banned(:,:,:), bannedOrb(:,:)
|
||||
double precision, allocatable :: coef_fullminilist_rev(:,:)
|
||||
double precision, allocatable :: coef_fullminilist_rev_complex(:,:)
|
||||
|
||||
|
||||
double precision, allocatable :: mat(:,:,:)
|
||||
double precision, allocatable :: mat_complex(:,:,:)
|
||||
|
||||
logical :: monoAdo, monoBdo
|
||||
integer :: maskInd
|
||||
|
||||
@ -224,3 +224,157 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
|
||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||
end subroutine
|
||||
|
||||
|
||||
!==============================================================================!
|
||||
! !
|
||||
! Complex !
|
||||
! !
|
||||
!==============================================================================!
|
||||
|
||||
subroutine ZMQ_selection_complex(N_in, pt2, variance, norm)
|
||||
!todo: implement
|
||||
print*,irp_here
|
||||
stop -1
|
||||
use f77_zmq
|
||||
use selection_types
|
||||
|
||||
implicit none
|
||||
|
||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull
|
||||
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)
|
||||
double precision, intent(out) :: variance(N_states)
|
||||
double precision, intent(out) :: norm(N_states)
|
||||
|
||||
! PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators
|
||||
|
||||
N = max(N_in,1)
|
||||
if (.True.) then
|
||||
PROVIDE pt2_e0_denominator nproc
|
||||
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 selection_weight pseudo_sym
|
||||
|
||||
|
||||
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection')
|
||||
|
||||
integer, external :: zmq_put_psi
|
||||
integer, external :: zmq_put_N_det_generators
|
||||
integer, external :: zmq_put_N_det_selectors
|
||||
integer, external :: zmq_put_dvector
|
||||
|
||||
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',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then
|
||||
stop 'Unable to put energy on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then
|
||||
stop 'Unable to put state_average_weight on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then
|
||||
stop 'Unable to put selection_weight on ZMQ server'
|
||||
endif
|
||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then
|
||||
stop 'Unable to put threshold_generators on ZMQ server'
|
||||
endif
|
||||
call create_selection_buffer(N, N*2, b)
|
||||
endif
|
||||
|
||||
integer, external :: add_task_to_taskserver
|
||||
character(len=100000) :: task
|
||||
integer :: j,k,ipos
|
||||
ipos=1
|
||||
task = ' '
|
||||
|
||||
do i= 1, N_det_generators
|
||||
do j=1,pt2_F(i)
|
||||
write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N
|
||||
ipos += 30
|
||||
if (ipos > 100000-30) 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
|
||||
enddo
|
||||
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
|
||||
|
||||
|
||||
ASSERT (associated(b%det))
|
||||
ASSERT (associated(b%val))
|
||||
|
||||
integer, external :: zmq_set_running
|
||||
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||
print *, irp_here, ': Failed in zmq_set_running'
|
||||
endif
|
||||
|
||||
integer :: nproc_target
|
||||
if (N_det < 3*nproc) then
|
||||
nproc_target = N_det/4
|
||||
else
|
||||
nproc_target = nproc
|
||||
endif
|
||||
double precision :: mem
|
||||
mem = 8.d0 * N_det * (N_int * 2.d0 * 3.d0 + 3.d0 + 5.d0) / (1024.d0**3)
|
||||
call write_double(6,mem,'Estimated memory/thread (Gb)')
|
||||
if (qp_max_mem > 0) then
|
||||
nproc_target = max(1,int(dble(qp_max_mem)/(0.1d0 + mem)))
|
||||
nproc_target = min(nproc_target,nproc)
|
||||
endif
|
||||
|
||||
f(:) = 1.d0
|
||||
if (.not.do_pt2) then
|
||||
double precision :: f(N_states), u_dot_u_complex
|
||||
do k=1,min(N_det,N_states)
|
||||
f(k) = 1.d0 / u_dot_u_complex(psi_selectors_coef_complex(1,k), N_det_selectors)
|
||||
enddo
|
||||
endif
|
||||
|
||||
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1)
|
||||
i = omp_get_thread_num()
|
||||
if (i==0) then
|
||||
call selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
|
||||
else
|
||||
call selection_slave_inproc(i)
|
||||
endif
|
||||
!$OMP END PARALLEL
|
||||
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection')
|
||||
do i=N_det+1,N_states
|
||||
pt2(i) = 0.d0
|
||||
variance(i) = 0.d0
|
||||
norm(i) = 0.d0
|
||||
enddo
|
||||
if (N_in > 0) then
|
||||
if (s2_eig) then
|
||||
call make_selection_buffer_s2(b)
|
||||
endif
|
||||
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0)
|
||||
call copy_H_apply_buffer_to_wf()
|
||||
call save_wavefunction
|
||||
endif
|
||||
call delete_selection_buffer(b)
|
||||
do k=1,N_states
|
||||
pt2(k) = pt2(k) * f(k)
|
||||
variance(k) = variance(k) * f(k)
|
||||
norm(k) = norm(k) * f(k)
|
||||
enddo
|
||||
|
||||
call update_pt2_and_variance_weights(pt2, variance, norm, N_states)
|
||||
|
||||
end subroutine
|
||||
|
||||
@ -410,14 +410,13 @@ END_PROVIDER
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
subroutine diagonalize_CI
|
||||
subroutine diagonalize_CI_complex
|
||||
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
|
||||
if (is_complex) then
|
||||
do j=1,N_states
|
||||
do i=1,N_det
|
||||
psi_coef_complex(i,j) = ci_eigenvectors_complex(i,j)
|
||||
@ -425,9 +424,17 @@ subroutine diagonalize_CI
|
||||
enddo
|
||||
psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
||||
psi_s2(1:N_states) = CI_s2(1:N_states)
|
||||
!todo: touch complex?
|
||||
SOFT_TOUCH psi_coef_complex CI_electronic_energy ci_energy CI_eigenvectors_complex CI_s2 psi_energy psi_s2
|
||||
else
|
||||
!todo: touch ci_{sc,electronic_energy}?
|
||||
SOFT_TOUCH psi_coef_complex CI_electronic_energy_complex ci_energy CI_eigenvectors_complex CI_s2_complex psi_energy psi_s2
|
||||
end
|
||||
|
||||
subroutine diagonalize_CI
|
||||
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(i,j)
|
||||
@ -436,7 +443,6 @@ subroutine diagonalize_CI
|
||||
psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
||||
psi_s2(1:N_states) = CI_s2(1:N_states)
|
||||
|
||||
!todo: touch real?
|
||||
SOFT_TOUCH psi_coef CI_electronic_energy CI_energy CI_eigenvectors CI_s2 psi_energy psi_s2
|
||||
endif
|
||||
!todo: touch ci_{sc,electronic_energy}?
|
||||
SOFT_TOUCH psi_coef CI_electronic_energy_real ci_energy CI_eigenvectors CI_s2_real psi_energy psi_s2
|
||||
end
|
||||
|
||||
@ -18,6 +18,16 @@ subroutine print_energy_components()
|
||||
Vecp = 0.d0
|
||||
T = 0.d0
|
||||
|
||||
if (is_complex) then
|
||||
do j=1,mo_num
|
||||
do i=1,mo_num
|
||||
f = one_e_dm_mo_alpha_complex(i,j,k) + one_e_dm_mo_beta_complex(i,j,k)
|
||||
Ven = Ven + dble(f * mo_integrals_n_e_complex(j,i))
|
||||
Vecp = Vecp + dble(f * mo_pseudo_integrals_complex(j,i))
|
||||
T = T + dble(f * mo_kinetic_integrals_complex(j,i))
|
||||
enddo
|
||||
enddo
|
||||
else
|
||||
do j=1,mo_num
|
||||
do i=1,mo_num
|
||||
f = one_e_dm_mo_alpha(i,j,k) + one_e_dm_mo_beta(i,j,k)
|
||||
@ -26,6 +36,7 @@ subroutine print_energy_components()
|
||||
T = T + f * mo_kinetic_integrals(i,j)
|
||||
enddo
|
||||
enddo
|
||||
endif
|
||||
Vee = psi_energy(k) - Ven - Vecp - T
|
||||
|
||||
if (ifirst == 0) then
|
||||
|
||||
@ -5,6 +5,7 @@
|
||||
! psi_energy(i) = $\langle \Psi_i | H | \Psi_i \rangle$
|
||||
!
|
||||
! psi_s2(i) = $\langle \Psi_i | S^2 | \Psi_i \rangle$
|
||||
! real and complex
|
||||
END_DOC
|
||||
if (is_complex) then
|
||||
call u_0_h_u_0_complex(psi_energy,psi_s2,psi_coef_complex,N_det,psi_det,N_int,N_states,psi_det_size)
|
||||
|
||||
@ -1,7 +1,18 @@
|
||||
|
||||
-------------------------------------------------------------------------------------
|
||||
current:
|
||||
fci
|
||||
run_cipsi
|
||||
zmq_pt2_complex
|
||||
selection buffer? (val, mini)?
|
||||
selection_slave_inproc
|
||||
zmq_selection_complex
|
||||
run_slave_cipsi
|
||||
run_stochastic_cipsi
|
||||
|
||||
-------------------------------------------------------------------------------------
|
||||
|
||||
old:
|
||||
irp_align for complex?
|
||||
zmq_put_psi_complex instead of branch inside zmq_put_psi?
|
||||
are there cases where we call this without already being on a complex branch of code?
|
||||
|
||||
Loading…
Reference in New Issue
Block a user