mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-07-08 12:26:01 +02:00
complex cleanup
This commit is contained in:
Kevin Gasperich
parent
5b214ac3c1
commit
d6fb0f63fe
|
|
@ -854,240 +854,240 @@ END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine ZMQ_pt2_complex(E, pt2,relative_error, error, variance, norm, N_in)
|
!subroutine ZMQ_pt2_complex(E, pt2,relative_error, error, variance, norm, N_in)
|
||||||
!todo: implement for complex
|
! !todo: implement for complex
|
||||||
print*,irp_here
|
! print*,irp_here
|
||||||
stop -1
|
! stop -1
|
||||||
use f77_zmq
|
! use f77_zmq
|
||||||
use selection_types
|
! use selection_types
|
||||||
|
!
|
||||||
implicit none
|
! implicit none
|
||||||
|
!
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
|
! integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
|
||||||
integer, intent(in) :: N_in
|
! integer, intent(in) :: N_in
|
||||||
double precision, intent(in) :: relative_error, E(N_states)
|
! double precision, intent(in) :: relative_error, E(N_states)
|
||||||
double precision, intent(out) :: pt2(N_states),error(N_states)
|
! double precision, intent(out) :: pt2(N_states),error(N_states)
|
||||||
double precision, intent(out) :: variance(N_states),norm(N_states)
|
! double precision, intent(out) :: variance(N_states),norm(N_states)
|
||||||
|
!
|
||||||
|
!
|
||||||
integer :: i, N
|
! integer :: i, N
|
||||||
|
!
|
||||||
double precision :: state_average_weight_save(N_states), w(N_states,4)
|
! double precision :: state_average_weight_save(N_states), w(N_states,4)
|
||||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
! integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||||
type(selection_buffer) :: b
|
! type(selection_buffer) :: b
|
||||||
|
!
|
||||||
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
! PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
||||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
! PROVIDE psi_bilinear_matrix_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_rows_loc psi_bilinear_matrix_transp_columns
|
||||||
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_complex psi_det_sorted
|
! PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_complex psi_det_sorted
|
||||||
PROVIDE psi_det_hii selection_weight pseudo_sym
|
! PROVIDE psi_det_hii selection_weight pseudo_sym
|
||||||
|
!
|
||||||
if (h0_type == 'SOP') then
|
! if (h0_type == 'SOP') then
|
||||||
PROVIDE psi_occ_pattern_hii det_to_occ_pattern
|
! PROVIDE psi_occ_pattern_hii det_to_occ_pattern
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
if (N_det <= max(4,N_states)) then
|
! if (N_det <= max(4,N_states)) then
|
||||||
pt2=0.d0
|
! pt2=0.d0
|
||||||
variance=0.d0
|
! variance=0.d0
|
||||||
norm=0.d0
|
! norm=0.d0
|
||||||
call zmq_selection_complex(N_in, pt2, variance, norm)
|
! call zmq_selection_complex(N_in, pt2, variance, norm)
|
||||||
error(:) = 0.d0
|
! error(:) = 0.d0
|
||||||
else
|
! else
|
||||||
|
!
|
||||||
N = max(N_in,1) * N_states
|
! N = max(N_in,1) * N_states
|
||||||
state_average_weight_save(:) = state_average_weight(:)
|
! state_average_weight_save(:) = state_average_weight(:)
|
||||||
if (int(N,8)*2_8 > huge(1)) then
|
! if (int(N,8)*2_8 > huge(1)) then
|
||||||
print *, irp_here, ': integer too large'
|
! print *, irp_here, ': integer too large'
|
||||||
stop -1
|
! stop -1
|
||||||
endif
|
! endif
|
||||||
call create_selection_buffer(N, N*2, b)
|
! call create_selection_buffer(N, N*2, b)
|
||||||
ASSERT (associated(b%det))
|
! ASSERT (associated(b%det))
|
||||||
ASSERT (associated(b%val))
|
! ASSERT (associated(b%val))
|
||||||
|
!
|
||||||
do pt2_stoch_istate=1,N_states
|
! do pt2_stoch_istate=1,N_states
|
||||||
state_average_weight(:) = 0.d0
|
! state_average_weight(:) = 0.d0
|
||||||
state_average_weight(pt2_stoch_istate) = 1.d0
|
! state_average_weight(pt2_stoch_istate) = 1.d0
|
||||||
TOUCH state_average_weight pt2_stoch_istate selection_weight
|
! 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 nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w
|
||||||
PROVIDE psi_selectors pt2_u pt2_J pt2_R
|
! PROVIDE psi_selectors pt2_u pt2_J pt2_R
|
||||||
call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
|
! call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
|
||||||
|
!
|
||||||
integer, external :: zmq_put_psi
|
! integer, external :: zmq_put_psi
|
||||||
integer, external :: zmq_put_N_det_generators
|
! integer, external :: zmq_put_N_det_generators
|
||||||
integer, external :: zmq_put_N_det_selectors
|
! integer, external :: zmq_put_N_det_selectors
|
||||||
integer, external :: zmq_put_dvector
|
! integer, external :: zmq_put_dvector
|
||||||
integer, external :: zmq_put_ivector
|
! integer, external :: zmq_put_ivector
|
||||||
if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
|
! if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
|
||||||
stop 'Unable to put psi on ZMQ server'
|
! stop 'Unable to put psi on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then
|
! if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then
|
||||||
stop 'Unable to put N_det_generators on ZMQ server'
|
! stop 'Unable to put N_det_generators on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then
|
! if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then
|
||||||
stop 'Unable to put N_det_selectors on ZMQ server'
|
! stop 'Unable to put N_det_selectors on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then
|
! 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'
|
! stop 'Unable to put energy on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then
|
! 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'
|
! stop 'Unable to put state_average_weight on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then
|
! 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'
|
! stop 'Unable to put selection_weight on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then
|
! 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'
|
! stop 'Unable to put pt2_stoch_istate on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then
|
! 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'
|
! stop 'Unable to put threshold_generators on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
|
!
|
||||||
integer, external :: add_task_to_taskserver
|
! integer, external :: add_task_to_taskserver
|
||||||
character(300000) :: task
|
! character(300000) :: task
|
||||||
|
!
|
||||||
integer :: j,k,ipos,ifirst
|
! integer :: j,k,ipos,ifirst
|
||||||
ifirst=0
|
! ifirst=0
|
||||||
|
!
|
||||||
ipos=0
|
! ipos=0
|
||||||
do i=1,N_det_generators
|
! do i=1,N_det_generators
|
||||||
if (pt2_F(i) > 1) then
|
! if (pt2_F(i) > 1) then
|
||||||
ipos += 1
|
! ipos += 1
|
||||||
endif
|
! endif
|
||||||
enddo
|
! enddo
|
||||||
call write_int(6,sum(pt2_F),'Number of tasks')
|
! call write_int(6,sum(pt2_F),'Number of tasks')
|
||||||
call write_int(6,ipos,'Number of fragmented tasks')
|
! call write_int(6,ipos,'Number of fragmented tasks')
|
||||||
|
!
|
||||||
ipos=1
|
! ipos=1
|
||||||
do i= 1, N_det_generators
|
! do i= 1, N_det_generators
|
||||||
do j=1,pt2_F(pt2_J(i))
|
! do j=1,pt2_F(pt2_J(i))
|
||||||
write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in
|
! write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in
|
||||||
ipos += 30
|
! ipos += 30
|
||||||
if (ipos > 300000-30) then
|
! if (ipos > 300000-30) then
|
||||||
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1: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'
|
! stop 'Unable to add task to task server'
|
||||||
endif
|
! endif
|
||||||
ipos=1
|
! ipos=1
|
||||||
if (ifirst == 0) then
|
! if (ifirst == 0) then
|
||||||
ifirst=1
|
! ifirst=1
|
||||||
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
! if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||||
print *, irp_here, ': Failed in zmq_set_running'
|
! print *, irp_here, ': Failed in zmq_set_running'
|
||||||
endif
|
! endif
|
||||||
endif
|
! endif
|
||||||
endif
|
! endif
|
||||||
end do
|
! end do
|
||||||
enddo
|
! enddo
|
||||||
if (ipos > 1) then
|
! if (ipos > 1) then
|
||||||
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1: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'
|
! stop 'Unable to add task to task server'
|
||||||
endif
|
! endif
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
integer, external :: zmq_set_running
|
! integer, external :: zmq_set_running
|
||||||
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
! if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||||
print *, irp_here, ': Failed in zmq_set_running'
|
! print *, irp_here, ': Failed in zmq_set_running'
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
|
!
|
||||||
double precision :: mem_collector, mem, rss
|
! double precision :: mem_collector, mem, rss
|
||||||
|
!
|
||||||
call resident_memory(rss)
|
! call resident_memory(rss)
|
||||||
|
!
|
||||||
mem_collector = 8.d0 * & ! bytes
|
! mem_collector = 8.d0 * & ! bytes
|
||||||
( 1.d0*pt2_n_tasks_max & ! task_id, index
|
! ( 1.d0*pt2_n_tasks_max & ! task_id, index
|
||||||
+ 0.635d0*N_det_generators & ! f,d
|
! + 0.635d0*N_det_generators & ! f,d
|
||||||
+ 3.d0*N_det_generators*N_states & ! eI, vI, nI
|
! + 3.d0*N_det_generators*N_states & ! eI, vI, nI
|
||||||
+ 3.d0*pt2_n_tasks_max*N_states & ! eI_task, vI_task, nI_task
|
! + 3.d0*pt2_n_tasks_max*N_states & ! eI_task, vI_task, nI_task
|
||||||
+ 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3
|
! + 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) & ! selection buffer
|
||||||
+ 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer
|
! + 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer
|
||||||
) / 1024.d0**3
|
! ) / 1024.d0**3
|
||||||
|
!
|
||||||
integer :: nproc_target, ii
|
! integer :: nproc_target, ii
|
||||||
nproc_target = nthreads_pt2
|
! nproc_target = nthreads_pt2
|
||||||
ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2)
|
! ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2)
|
||||||
|
!
|
||||||
do
|
! do
|
||||||
mem = mem_collector + & !
|
! mem = mem_collector + & !
|
||||||
nproc_target * 8.d0 * & ! bytes
|
! nproc_target * 8.d0 * & ! bytes
|
||||||
( 0.5d0*pt2_n_tasks_max & ! task_id
|
! ( 0.5d0*pt2_n_tasks_max & ! task_id
|
||||||
+ 64.d0*pt2_n_tasks_max & ! task
|
! + 64.d0*pt2_n_tasks_max & ! task
|
||||||
+ 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm
|
! + 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm
|
||||||
+ 1.d0*pt2_n_tasks_max & ! i_generator, subset
|
! + 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) & ! selection buffer
|
||||||
+ 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer
|
! + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer
|
||||||
+ 2.0d0*(ii) & ! preinteresting, interesting,
|
! + 2.0d0*(ii) & ! preinteresting, interesting,
|
||||||
! prefullinteresting, fullinteresting
|
! ! prefullinteresting, fullinteresting
|
||||||
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
! + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
||||||
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
|
! + 1.0d0*(N_states*mo_num*mo_num) & ! mat
|
||||||
) / 1024.d0**3
|
! ) / 1024.d0**3
|
||||||
|
!
|
||||||
if (nproc_target == 0) then
|
! if (nproc_target == 0) then
|
||||||
call check_mem(mem,irp_here)
|
! call check_mem(mem,irp_here)
|
||||||
nproc_target = 1
|
! nproc_target = 1
|
||||||
exit
|
! exit
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
if (mem+rss < qp_max_mem) then
|
! if (mem+rss < qp_max_mem) then
|
||||||
exit
|
! exit
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
nproc_target = nproc_target - 1
|
! nproc_target = nproc_target - 1
|
||||||
|
!
|
||||||
enddo
|
! enddo
|
||||||
call write_int(6,nproc_target,'Number of threads for PT2')
|
! call write_int(6,nproc_target,'Number of threads for PT2')
|
||||||
call write_double(6,mem,'Memory (Gb)')
|
! call write_double(6,mem,'Memory (Gb)')
|
||||||
|
!
|
||||||
call omp_set_nested(.false.)
|
! call omp_set_nested(.false.)
|
||||||
|
!
|
||||||
|
!
|
||||||
print '(A)', '========== ================= =========== =============== =============== ================='
|
! print '(A)', '========== ================= =========== =============== =============== ================='
|
||||||
print '(A)', ' Samples Energy Stat. Err Variance Norm Seconds '
|
! print '(A)', ' Samples Energy Stat. Err Variance Norm Seconds '
|
||||||
print '(A)', '========== ================= =========== =============== =============== ================='
|
! print '(A)', '========== ================= =========== =============== =============== ================='
|
||||||
|
!
|
||||||
PROVIDE global_selection_buffer
|
! PROVIDE global_selection_buffer
|
||||||
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) &
|
! !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) &
|
||||||
!$OMP PRIVATE(i)
|
! !$OMP PRIVATE(i)
|
||||||
i = omp_get_thread_num()
|
! i = omp_get_thread_num()
|
||||||
if (i==0) then
|
! 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)
|
! 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)
|
! pt2(pt2_stoch_istate) = w(pt2_stoch_istate,1)
|
||||||
error(pt2_stoch_istate) = w(pt2_stoch_istate,2)
|
! error(pt2_stoch_istate) = w(pt2_stoch_istate,2)
|
||||||
variance(pt2_stoch_istate) = w(pt2_stoch_istate,3)
|
! variance(pt2_stoch_istate) = w(pt2_stoch_istate,3)
|
||||||
norm(pt2_stoch_istate) = w(pt2_stoch_istate,4)
|
! norm(pt2_stoch_istate) = w(pt2_stoch_istate,4)
|
||||||
|
!
|
||||||
else
|
! else
|
||||||
call pt2_slave_inproc(i)
|
! call pt2_slave_inproc(i)
|
||||||
endif
|
! endif
|
||||||
!$OMP END PARALLEL
|
! !$OMP END PARALLEL
|
||||||
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
|
! call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
|
||||||
|
!
|
||||||
print '(A)', '========== ================= =========== =============== =============== ================='
|
! print '(A)', '========== ================= =========== =============== =============== ================='
|
||||||
|
!
|
||||||
enddo
|
! enddo
|
||||||
FREE pt2_stoch_istate
|
! FREE pt2_stoch_istate
|
||||||
|
!
|
||||||
if (N_in > 0) then
|
! if (N_in > 0) then
|
||||||
b%cur = min(N_in,b%cur)
|
! b%cur = min(N_in,b%cur)
|
||||||
if (s2_eig) then
|
! if (s2_eig) then
|
||||||
call make_selection_buffer_s2(b)
|
! call make_selection_buffer_s2(b)
|
||||||
else
|
! else
|
||||||
call remove_duplicates_in_selection_buffer(b)
|
! call remove_duplicates_in_selection_buffer(b)
|
||||||
endif
|
! endif
|
||||||
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0)
|
! call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0)
|
||||||
endif
|
! endif
|
||||||
call delete_selection_buffer(b)
|
! call delete_selection_buffer(b)
|
||||||
|
!
|
||||||
state_average_weight(:) = state_average_weight_save(:)
|
! state_average_weight(:) = state_average_weight_save(:)
|
||||||
TOUCH state_average_weight
|
! TOUCH state_average_weight
|
||||||
endif
|
! endif
|
||||||
do k=N_det+1,N_states
|
! do k=N_det+1,N_states
|
||||||
pt2(k) = 0.d0
|
! pt2(k) = 0.d0
|
||||||
enddo
|
! enddo
|
||||||
|
!
|
||||||
call update_pt2_and_variance_weights(pt2, variance, norm, N_states)
|
! call update_pt2_and_variance_weights(pt2, variance, norm, N_states)
|
||||||
|
!
|
||||||
end subroutine
|
!end subroutine
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -2037,7 +2037,7 @@ end
|
||||||
!==============================================================================!
|
!==============================================================================!
|
||||||
|
|
||||||
subroutine fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf)
|
subroutine fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, variance, norm, mat, buf)
|
||||||
!todo: check indices for complex?
|
!todo: should be okay for complex
|
||||||
use bitmasks
|
use bitmasks
|
||||||
use selection_types
|
use selection_types
|
||||||
implicit none
|
implicit none
|
||||||
|
|
@ -2212,7 +2212,6 @@ subroutine fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine splash_pq_complex(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting)
|
subroutine splash_pq_complex(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting)
|
||||||
!todo: check indices for complex?
|
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
|
|
||||||
|
|
@ -17,7 +17,7 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
|
||||||
|
|
||||||
N = max(N_in,1)
|
N = max(N_in,1)
|
||||||
if (.True.) then
|
if (.True.) then
|
||||||
!todo: some providers have becom unlinked for real/complex (det/coef); do these need to be provided?
|
!todo: some providers have become unlinked for real/complex (det/coef); do these need to be provided?
|
||||||
PROVIDE pt2_e0_denominator nproc
|
PROVIDE pt2_e0_denominator nproc
|
||||||
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
||||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
||||||
|
|
@ -239,150 +239,150 @@ end subroutine
|
||||||
! !
|
! !
|
||||||
!==============================================================================!
|
!==============================================================================!
|
||||||
|
|
||||||
subroutine ZMQ_selection_complex(N_in, pt2, variance, norm)
|
!subroutine ZMQ_selection_complex(N_in, pt2, variance, norm)
|
||||||
!todo: implement
|
! !todo: implement
|
||||||
print*,irp_here
|
! print*,irp_here
|
||||||
stop -1
|
! stop -1
|
||||||
use f77_zmq
|
! use f77_zmq
|
||||||
use selection_types
|
! use selection_types
|
||||||
|
!
|
||||||
implicit none
|
! implicit none
|
||||||
|
!
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull
|
! integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull
|
||||||
integer, intent(in) :: N_in
|
! integer, intent(in) :: N_in
|
||||||
type(selection_buffer) :: b
|
! type(selection_buffer) :: b
|
||||||
integer :: i, N
|
! integer :: i, N
|
||||||
integer, external :: omp_get_thread_num
|
! integer, external :: omp_get_thread_num
|
||||||
double precision, intent(out) :: pt2(N_states)
|
! double precision, intent(out) :: pt2(N_states)
|
||||||
double precision, intent(out) :: variance(N_states)
|
! double precision, intent(out) :: variance(N_states)
|
||||||
double precision, intent(out) :: norm(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
|
!! PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators
|
||||||
|
!
|
||||||
N = max(N_in,1)
|
! N = max(N_in,1)
|
||||||
if (.True.) then
|
! if (.True.) then
|
||||||
PROVIDE pt2_e0_denominator nproc
|
! PROVIDE pt2_e0_denominator nproc
|
||||||
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
! PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
||||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
! PROVIDE psi_bilinear_matrix_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_rows_loc psi_bilinear_matrix_transp_columns
|
||||||
PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym
|
! PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym
|
||||||
|
!
|
||||||
|
!
|
||||||
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection')
|
! call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection')
|
||||||
|
!
|
||||||
integer, external :: zmq_put_psi
|
! integer, external :: zmq_put_psi
|
||||||
integer, external :: zmq_put_N_det_generators
|
! integer, external :: zmq_put_N_det_generators
|
||||||
integer, external :: zmq_put_N_det_selectors
|
! integer, external :: zmq_put_N_det_selectors
|
||||||
integer, external :: zmq_put_dvector
|
! integer, external :: zmq_put_dvector
|
||||||
|
!
|
||||||
if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
|
! if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
|
||||||
stop 'Unable to put psi on ZMQ server'
|
! stop 'Unable to put psi on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then
|
! if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then
|
||||||
stop 'Unable to put N_det_generators on ZMQ server'
|
! stop 'Unable to put N_det_generators on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then
|
! if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then
|
||||||
stop 'Unable to put N_det_selectors on ZMQ server'
|
! stop 'Unable to put N_det_selectors on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then
|
! 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'
|
! stop 'Unable to put energy on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then
|
! 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'
|
! stop 'Unable to put state_average_weight on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then
|
! 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'
|
! stop 'Unable to put selection_weight on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) then
|
! 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'
|
! stop 'Unable to put threshold_generators on ZMQ server'
|
||||||
endif
|
! endif
|
||||||
call create_selection_buffer(N, N*2, b)
|
! call create_selection_buffer(N, N*2, b)
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
integer, external :: add_task_to_taskserver
|
! integer, external :: add_task_to_taskserver
|
||||||
character(len=100000) :: task
|
! character(len=100000) :: task
|
||||||
integer :: j,k,ipos
|
! integer :: j,k,ipos
|
||||||
ipos=1
|
! ipos=1
|
||||||
task = ' '
|
! task = ' '
|
||||||
|
!
|
||||||
do i= 1, N_det_generators
|
! do i= 1, N_det_generators
|
||||||
do j=1,pt2_F(i)
|
! do j=1,pt2_F(i)
|
||||||
write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N
|
! write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N
|
||||||
ipos += 30
|
! ipos += 30
|
||||||
if (ipos > 100000-30) then
|
! if (ipos > 100000-30) then
|
||||||
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1: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'
|
! stop 'Unable to add task to task server'
|
||||||
endif
|
! endif
|
||||||
ipos=1
|
! ipos=1
|
||||||
endif
|
! endif
|
||||||
end do
|
! end do
|
||||||
enddo
|
! enddo
|
||||||
if (ipos > 1) then
|
! if (ipos > 1) then
|
||||||
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1: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'
|
! stop 'Unable to add task to task server'
|
||||||
endif
|
! endif
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
|
!
|
||||||
ASSERT (associated(b%det))
|
! ASSERT (associated(b%det))
|
||||||
ASSERT (associated(b%val))
|
! ASSERT (associated(b%val))
|
||||||
|
!
|
||||||
integer, external :: zmq_set_running
|
! integer, external :: zmq_set_running
|
||||||
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
! if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||||
print *, irp_here, ': Failed in zmq_set_running'
|
! print *, irp_here, ': Failed in zmq_set_running'
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
integer :: nproc_target
|
! integer :: nproc_target
|
||||||
if (N_det < 3*nproc) then
|
! if (N_det < 3*nproc) then
|
||||||
nproc_target = N_det/4
|
! nproc_target = N_det/4
|
||||||
else
|
! else
|
||||||
nproc_target = nproc
|
! nproc_target = nproc
|
||||||
endif
|
! endif
|
||||||
double precision :: mem
|
! double precision :: mem
|
||||||
mem = 8.d0 * N_det * (N_int * 2.d0 * 3.d0 + 3.d0 + 5.d0) / (1024.d0**3)
|
! 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)')
|
! call write_double(6,mem,'Estimated memory/thread (Gb)')
|
||||||
if (qp_max_mem > 0) then
|
! if (qp_max_mem > 0) then
|
||||||
nproc_target = max(1,int(dble(qp_max_mem)/(0.1d0 + mem)))
|
! nproc_target = max(1,int(dble(qp_max_mem)/(0.1d0 + mem)))
|
||||||
nproc_target = min(nproc_target,nproc)
|
! nproc_target = min(nproc_target,nproc)
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
f(:) = 1.d0
|
! f(:) = 1.d0
|
||||||
if (.not.do_pt2) then
|
! if (.not.do_pt2) then
|
||||||
double precision :: f(N_states), u_dot_u_complex
|
! double precision :: f(N_states), u_dot_u_complex
|
||||||
do k=1,min(N_det,N_states)
|
! 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)
|
! f(k) = 1.d0 / u_dot_u_complex(psi_selectors_coef_complex(1,k), N_det_selectors)
|
||||||
enddo
|
! enddo
|
||||||
endif
|
! endif
|
||||||
|
!
|
||||||
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1)
|
! !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1)
|
||||||
i = omp_get_thread_num()
|
! i = omp_get_thread_num()
|
||||||
if (i==0) then
|
! if (i==0) then
|
||||||
call selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
|
! call selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
|
||||||
else
|
! else
|
||||||
call selection_slave_inproc(i)
|
! call selection_slave_inproc(i)
|
||||||
endif
|
! endif
|
||||||
!$OMP END PARALLEL
|
! !$OMP END PARALLEL
|
||||||
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection')
|
! call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection')
|
||||||
do i=N_det+1,N_states
|
! do i=N_det+1,N_states
|
||||||
pt2(i) = 0.d0
|
! pt2(i) = 0.d0
|
||||||
variance(i) = 0.d0
|
! variance(i) = 0.d0
|
||||||
norm(i) = 0.d0
|
! norm(i) = 0.d0
|
||||||
enddo
|
! enddo
|
||||||
if (N_in > 0) then
|
! if (N_in > 0) then
|
||||||
if (s2_eig) then
|
! if (s2_eig) then
|
||||||
call make_selection_buffer_s2(b)
|
! call make_selection_buffer_s2(b)
|
||||||
endif
|
! endif
|
||||||
call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0)
|
! call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0)
|
||||||
call copy_H_apply_buffer_to_wf()
|
! call copy_H_apply_buffer_to_wf()
|
||||||
call save_wavefunction
|
! call save_wavefunction
|
||||||
endif
|
! endif
|
||||||
call delete_selection_buffer(b)
|
! call delete_selection_buffer(b)
|
||||||
do k=1,N_states
|
! do k=1,N_states
|
||||||
pt2(k) = pt2(k) * f(k)
|
! pt2(k) = pt2(k) * f(k)
|
||||||
variance(k) = variance(k) * f(k)
|
! variance(k) = variance(k) * f(k)
|
||||||
norm(k) = norm(k) * f(k)
|
! norm(k) = norm(k) * f(k)
|
||||||
enddo
|
! enddo
|
||||||
|
!
|
||||||
call update_pt2_and_variance_weights(pt2, variance, norm, N_states)
|
! call update_pt2_and_variance_weights(pt2, variance, norm, N_states)
|
||||||
|
!
|
||||||
end subroutine
|
!end subroutine
|
||||||
|
|
|
||||||
|
|
@ -122,7 +122,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
||||||
|
|
||||||
allocate(u_tc(N_st,N_det))
|
allocate(u_tc(N_st,N_det))
|
||||||
|
|
||||||
!todo: resize for complex?
|
!todo: resize for complex? (should be okay)
|
||||||
! Warning : dimensions are modified for efficiency, It is OK since we get the
|
! Warning : dimensions are modified for efficiency, It is OK since we get the
|
||||||
! full matrix
|
! full matrix
|
||||||
if (size(u_tc,kind=8) < 8388608_8) then
|
if (size(u_tc,kind=8) < 8388608_8) then
|
||||||
|
|
@ -718,9 +718,6 @@ end
|
||||||
!==============================================================================!
|
!==============================================================================!
|
||||||
|
|
||||||
subroutine davidson_push_results_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id)
|
subroutine davidson_push_results_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id)
|
||||||
!todo: implement for complex; check double sz
|
|
||||||
print*,irp_here,' not implemented for complex'
|
|
||||||
stop -1
|
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
|
@ -745,12 +742,12 @@ subroutine davidson_push_results_complex(zmq_socket_push, v_t, s_t, imin, imax,
|
||||||
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
|
||||||
if(rc /= 4) stop 'davidson_push_results failed to push imax'
|
if(rc /= 4) stop 'davidson_push_results failed to push imax'
|
||||||
|
|
||||||
!todo: double sz for complex?
|
!todo: double sz for complex? (done)
|
||||||
rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE)
|
rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz*2, ZMQ_SNDMORE)
|
||||||
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt'
|
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt'
|
||||||
|
|
||||||
!todo: double sz for complex?
|
!todo: double sz for complex? (done)
|
||||||
rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0)
|
rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz*2, 0)
|
||||||
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st'
|
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st'
|
||||||
|
|
||||||
! Activate is zmq_socket_push is a REQ
|
! Activate is zmq_socket_push is a REQ
|
||||||
|
|
@ -767,9 +764,6 @@ IRP_ENDIF
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
subroutine davidson_push_results_async_send_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id,sending)
|
subroutine davidson_push_results_async_send_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id,sending)
|
||||||
!todo: implement for complex; check double sz
|
|
||||||
print*,irp_here,' not implemented for complex'
|
|
||||||
stop -1
|
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
|
@ -801,21 +795,18 @@ subroutine davidson_push_results_async_send_complex(zmq_socket_push, v_t, s_t, i
|
||||||
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
|
||||||
if(rc /= 4) stop 'davidson_push_results failed to push imax'
|
if(rc /= 4) stop 'davidson_push_results failed to push imax'
|
||||||
|
|
||||||
!todo: double sz for complex?
|
!todo: double sz for complex? (done)
|
||||||
rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE)
|
rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz*2, ZMQ_SNDMORE)
|
||||||
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt'
|
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push vt'
|
||||||
|
|
||||||
!todo: double sz for complex?
|
!todo: double sz for complex? (done)
|
||||||
rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0)
|
rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz*2, 0)
|
||||||
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st'
|
if(rc8 /= 8_8*sz) stop 'davidson_push_results failed to push st'
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
subroutine davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
||||||
!todo: implement for complex; check double sz
|
|
||||||
print*,irp_here,' not implemented for complex'
|
|
||||||
stop -1
|
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
|
@ -841,12 +832,12 @@ subroutine davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax,
|
||||||
|
|
||||||
sz = (imax-imin+1)*N_states_diag
|
sz = (imax-imin+1)*N_states_diag
|
||||||
|
|
||||||
!todo: double sz for complex?
|
!todo: double sz for complex? (done)
|
||||||
rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz, 0)
|
rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz*2, 0)
|
||||||
if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull v_t'
|
if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull v_t'
|
||||||
|
|
||||||
!todo: double sz for complex?
|
!todo: double sz for complex? (done)
|
||||||
rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz, 0)
|
rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz*2, 0)
|
||||||
if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull s_t'
|
if(rc8 /= 8*sz) stop 'davidson_pull_results failed to pull s_t'
|
||||||
|
|
||||||
! Activate if zmq_socket_pull is a REP
|
! Activate if zmq_socket_pull is a REP
|
||||||
|
|
@ -863,9 +854,6 @@ end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine davidson_collector_complex(zmq_to_qp_run_socket, zmq_socket_pull, v0, s0, sze, N_st)
|
subroutine davidson_collector_complex(zmq_to_qp_run_socket, zmq_socket_pull, v0, s0, sze, N_st)
|
||||||
!todo: implement for complex; check conjg v_t s_t
|
|
||||||
print*,irp_here,' not implemented for complex'
|
|
||||||
stop -1
|
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
|
@ -899,8 +887,6 @@ subroutine davidson_collector_complex(zmq_to_qp_run_socket, zmq_socket_pull, v0,
|
||||||
endif
|
endif
|
||||||
do j=1,N_st
|
do j=1,N_st
|
||||||
do i=imin,imax
|
do i=imin,imax
|
||||||
!todo: conjg or no?
|
|
||||||
print*,irp_here,' not implemented for complex (conjg?)'
|
|
||||||
v0(i,j) = v0(i,j) + v_t(j,i)
|
v0(i,j) = v0(i,j) + v_t(j,i)
|
||||||
s0(i,j) = s0(i,j) + s_t(j,i)
|
s0(i,j) = s0(i,j) + s_t(j,i)
|
||||||
enddo
|
enddo
|
||||||
|
|
|
||||||
|
|
@ -424,7 +424,7 @@ subroutine diagonalize_CI_complex
|
||||||
enddo
|
enddo
|
||||||
psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
||||||
psi_s2(1:N_states) = CI_s2(1:N_states)
|
psi_s2(1:N_states) = CI_s2(1:N_states)
|
||||||
!todo: touch ci_{sc,electronic_energy}?
|
!todo: touch ci_{s2,electronic_energy}?
|
||||||
SOFT_TOUCH psi_coef_complex CI_electronic_energy_complex ci_energy CI_eigenvectors_complex CI_s2_complex psi_energy psi_s2
|
SOFT_TOUCH psi_coef_complex CI_electronic_energy_complex ci_energy CI_eigenvectors_complex CI_s2_complex psi_energy psi_s2
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
@ -443,6 +443,6 @@ subroutine diagonalize_CI
|
||||||
psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
||||||
psi_s2(1:N_states) = CI_s2(1:N_states)
|
psi_s2(1:N_states) = CI_s2(1:N_states)
|
||||||
|
|
||||||
!todo: touch ci_{sc,electronic_energy}?
|
!todo: touch ci_{s2,electronic_energy}?
|
||||||
SOFT_TOUCH psi_coef CI_electronic_energy_real ci_energy CI_eigenvectors CI_s2_real psi_energy psi_s2
|
SOFT_TOUCH psi_coef CI_electronic_energy_real ci_energy CI_eigenvectors CI_s2_real psi_energy psi_s2
|
||||||
end
|
end
|
||||||
|
|
|
||||||
|
|
@ -1114,12 +1114,12 @@ compute_singles=.True.
|
||||||
ASSERT (lrow <= N_det_alpha_unique)
|
ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
|
||||||
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
|
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
|
||||||
!todo: check arg order conjg/noconjg
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
call i_h_j_double_alpha_beta_complex(tmp_det,tmp_det2,$N_int,hij)
|
call i_h_j_double_alpha_beta_complex(tmp_det,tmp_det2,$N_int,hij)
|
||||||
call get_s2(tmp_det,tmp_det2,$N_int,sij)
|
call get_s2(tmp_det,tmp_det2,$N_int,sij)
|
||||||
!DIR$ LOOP COUNT AVG(4)
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
do l=1,N_st
|
do l=1,N_st
|
||||||
!todo: check arg order conjg/noconjg
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
s_t(l,k_a) = s_t(l,k_a) + sij * utl(l,kk+1)
|
s_t(l,k_a) = s_t(l,k_a) + sij * utl(l,kk+1)
|
||||||
enddo
|
enddo
|
||||||
|
|
@ -1205,12 +1205,12 @@ compute_singles=.True.
|
||||||
ASSERT (lrow <= N_det_alpha_unique)
|
ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
|
||||||
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
|
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
|
||||||
!todo: check arg order conjg/noconjg
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 1, hij)
|
call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 1, hij)
|
||||||
|
|
||||||
!DIR$ LOOP COUNT AVG(4)
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
do l=1,N_st
|
do l=1,N_st
|
||||||
!todo: check arg order conjg/noconjg
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
! single => sij = 0
|
! single => sij = 0
|
||||||
enddo
|
enddo
|
||||||
|
|
@ -1240,11 +1240,11 @@ compute_singles=.True.
|
||||||
lrow = psi_bilinear_matrix_rows(l_a)
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
ASSERT (lrow <= N_det_alpha_unique)
|
ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
|
||||||
!todo: check arg order conjg/noconjg
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
call i_h_j_double_spin_complex( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij)
|
call i_h_j_double_spin_complex( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij)
|
||||||
!DIR$ LOOP COUNT AVG(4)
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
do l=1,N_st
|
do l=1,N_st
|
||||||
!todo: check arg order conjg/noconjg
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
! same spin => sij = 0
|
! same spin => sij = 0
|
||||||
enddo
|
enddo
|
||||||
|
|
@ -1324,7 +1324,7 @@ compute_singles=.True.
|
||||||
call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 2, hij)
|
call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 2, hij)
|
||||||
!DIR$ LOOP COUNT AVG(4)
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
do l=1,N_st
|
do l=1,N_st
|
||||||
!todo: check arg order conjg/noconjg
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
! single => sij = 0
|
! single => sij = 0
|
||||||
enddo
|
enddo
|
||||||
|
|
@ -1355,12 +1355,12 @@ compute_singles=.True.
|
||||||
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
||||||
ASSERT (lcol <= N_det_beta_unique)
|
ASSERT (lcol <= N_det_beta_unique)
|
||||||
|
|
||||||
!todo: check arg order conjg/noconjg
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
call i_h_j_double_spin_complex( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij)
|
call i_h_j_double_spin_complex( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij)
|
||||||
|
|
||||||
!DIR$ LOOP COUNT AVG(4)
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
do l=1,N_st
|
do l=1,N_st
|
||||||
!todo: check arg order conjg/noconjg
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
! same spin => sij = 0
|
! same spin => sij = 0
|
||||||
enddo
|
enddo
|
||||||
|
|
@ -1390,7 +1390,6 @@ compute_singles=.True.
|
||||||
sij = dcmplx(diag_S_mat_elem(tmp_det,$N_int),0.d0)
|
sij = dcmplx(diag_S_mat_elem(tmp_det,$N_int),0.d0)
|
||||||
!DIR$ LOOP COUNT AVG(4)
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
do l=1,N_st
|
do l=1,N_st
|
||||||
!todo: check arg order conjg/noconjg
|
|
||||||
v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,k_a)
|
v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,k_a)
|
||||||
s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,k_a)
|
s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,k_a)
|
||||||
enddo
|
enddo
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user