LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-17 10:05:18 +02:00
Code Releases Activity

cleanup

Browse Source
This commit is contained in:
Kevin Gasperich 2020-03-05 15:57:40 -06:00
parent 046c71feca
commit bb8d52fc69
7 changed files with 22 additions and 420 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

253
src/cipsi/pt2_stoch_routines.irp.f
View File

@ -265,7 +265,6 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
double precision :: mem_collector, mem, rss
!todo: check memory allocation for complex
call resident_memory(rss)
mem_collector = 8.d0 * & ! bytes
@ -296,6 +295,10 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
) / 1024.d0**3
if (is_complex) then
! mat is complex
mem = mem + (nproc_target*8.d0*(N_states*mo_num* mo_num)) / 1024.d0**3
endif
if (nproc_target == 0) then
call check_mem(mem,irp_here)
@ -843,251 +846,3 @@ END_PROVIDER
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

5
src/cipsi/slave_cipsi.irp.f
View File

@ -267,7 +267,6 @@ subroutine run_slave_main
nproc_target = nthreads_pt2
ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2)
!todo: change memory estimate for complex
do
mem = rss + & !
nproc_target * 8.d0 * & ! bytes
@ -282,6 +281,10 @@ subroutine run_slave_main
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
) / 1024.d0**3
if (is_complex) then
! mat is complex
mem = mem + (nproc_target * 8.d0 * (n_states*mo_num*mo_num)) / 1024.d0**3
endif
if (nproc_target == 0) then
call check_mem(mem,irp_here)

153
src/cipsi/zmq_selection.irp.f
View File

@ -233,156 +233,3 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
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

23
src/davidson/diagonalization_hs2_dressed.irp.f
View File

@ -735,8 +735,6 @@ end
!==============================================================================!
subroutine davidson_diag_hs2_complex(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_diag,Nint,dressing_state,converged)
print*,irp_here,' not implemented for complex'
stop -1
use bitmasks
implicit none
BEGIN_DOC
@ -784,6 +782,7 @@ subroutine davidson_diag_hs2_complex(dets_in,u_in,s2_out,dim_in,energies,sze,N_s
!$OMP END PARALLEL
if (dressing_state > 0) then
!todo: implement for complex
print*,irp_here,' not implemented for complex if dressing_state > 0'
stop -1
do k=1,N_st
@ -799,8 +798,6 @@ end
subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_st,N_st_diag_in,Nint,dressing_state,converged)
print*,irp_here,' not implemented for complex'
stop -1
use bitmasks
use mmap_module
implicit none
@ -1024,7 +1021,6 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
y_s(N_st_diag*itermax,N_st_diag*itermax), &
lambda(N_st_diag*itermax))
!todo: complex types
h = (0.d0,0.d0)
U = (0.d0,0.d0)
y = (0.d0,0.d0)
@ -1103,20 +1099,23 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
endif
if (dressing_state > 0) then
!todo: implement for complex
print*,irp_here,' not implemented for complex (dressed)'
stop -1
!
! if (N_st == 1) then
!
! l = dressed_column_idx(1)
! double precision :: f
! f = 1.0d0/psi_coef(l,1)
! complex*16 :: f
! !todo: check for complex
! f = (1.0d0,0.d0)/psi_coef(l,1)
! do istate=1,N_st_diag
! do i=1,sze
! W(i,shift+istate) += dressing_column_h(i,1) *f * U(l,shift+istate)
! W(l,shift+istate) += dressing_column_h(i,1) *f * U(i,shift+istate)
! S(i,shift+istate) += real(dressing_column_s(i,1) *f * U(l,shift+istate))
! S(l,shift+istate) += real(dressing_column_s(i,1) *f * U(i,shift+istate))
! !todo: conjugate?
! W(i,shift+istate) += dressing_column_h_complex(i,1) *f * U(l,shift+istate)
! W(l,shift+istate) += dressing_column_h_complex(i,1) *f * U(i,shift+istate)
! S(i,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(l,shift+istate))
! S(l,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(i,shift+istate))
! enddo
!
! enddo
@ -1404,6 +1403,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
enddo
!if (U(k,j) * u_in(k,j) < 0.d0) then
!todo: complex! maybe change criterion here?
! if U is close to u_in, then arg(conjg(U)*u_in) will be near zero
if (dble(dconjg(U(k,j)) * u_in(k,j)) < 0.d0) then
do i=1,sze
W(i,j) = -W(i,j)
@ -1432,7 +1432,6 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
call write_time(6)
if (disk_based)then
!todo: already resized, but do we need to change c_f_pointer for complex?
! Remove temp files
integer, external :: getUnitAndOpen
call munmap( (/int(sze,8),int(N_st_diag*itermax,8)/), 2*8, fd_w, ptr_w )

1
src/determinants/zmq.irp.f
View File

@ -84,7 +84,6 @@ integer function zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id)
endif
if (is_complex) then
!todo: check this
if (size(psi_coef_complex,kind=8) /= psi_det_size*N_states) then
deallocate(psi_coef_complex)
allocate(psi_coef_complex(psi_det_size,N_states))

6
src/mo_basis/utils_cplx.irp.f
View File

@ -1,5 +1,5 @@
subroutine mo_as_eigvectors_of_mo_matrix_complex(matrix,n,m,label,sign,output)
!TODO: test this; should we assign values to mo_coef and mo_coef_imag here?
!TODO: test this
implicit none
integer,intent(in) :: n,m, sign
character*(64), intent(in) :: label
@ -67,7 +67,7 @@ subroutine mo_as_eigvectors_of_mo_matrix_complex(matrix,n,m,label,sign,output)
end
subroutine mo_as_svd_vectors_of_mo_matrix_complex(matrix,lda,m,n,label)
!TODO: test this; should we assign values to mo_coef and mo_coef_imag here?
!TODO: test this
implicit none
integer,intent(in) :: lda,m,n
character*(64), intent(in) :: label
@ -122,7 +122,7 @@ end
subroutine mo_as_svd_vectors_of_mo_matrix_eig_complex(matrix,lda,m,n,eig,label)
!TODO: test this; should we assign values to mo_coef and mo_coef_imag here?
!TODO: test this
implicit none
integer,intent(in) :: lda,m,n
character*(64), intent(in) :: label

1
src/mo_guess/h_core_guess_routine.irp.f
View File

@ -10,7 +10,6 @@ subroutine hcore_guess
size(mo_one_e_integrals_complex,1), &
size(mo_one_e_integrals_complex,2),label,1,.false.)
call save_mos
!TODO: is this correct? decide how to handle separate real/imag parts of mo_coef
SOFT_TOUCH mo_coef_complex mo_label
else