LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-16 18:25:27 +02:00
Code Issues Releases Wiki Activity

Temporary fix for parallel davdison

Browse Source
This commit is contained in:
Anthony Scemama 2017-03-25 11:56:08 +01:00
parent 2cd4a513dc
commit 1ae57b97f8
4 changed files with 15 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Davidson/davidson_parallel.irp.f
View File

@ -54,6 +54,8 @@ subroutine davidson_process(blockb, blockb2, N, idx, vt, st, bs, istep)
org_j = sort_idx_(j,1)
call i_h_j (dav_det(1,1,org_j),dav_det(1,1,org_i),n_int,hij)
call get_s2(dav_det(1,1,org_j),dav_det(1,1,org_i),n_int,s2)
! call i_h_j (sorted_(1,j,1),sorted_(1,i,1),n_int,hij)
! call get_s2(sorted_(1,j,1),sorted_(1,i,1),n_int,s2)
if(.not. wrotten(ii)) then
wrotten(ii) = .true.
idx(ii) = org_i
@ -70,11 +72,15 @@ subroutine davidson_process(blockb, blockb2, N, idx, vt, st, bs, istep)
enddo
if (blockb <= shortcut_(0,2)) then
if ( blockb <= shortcut_(0,2) ) then
sh=blockb
do sh2=sh, shortcut_(0,2), shortcut_(0,1)
do i=blockb2+shortcut_(sh2,2),shortcut_(sh2+1,2)-1, istep
ii += 1
if (ii>bs) then
print *, irp_here
stop 'ii>bs'
endif
org_i = sort_idx_(i,2)
do j=shortcut_(sh2,2),shortcut_(sh2+1,2)-1
if(i == j) cycle
@ -88,6 +94,8 @@ subroutine davidson_process(blockb, blockb2, N, idx, vt, st, bs, istep)
if(ext == 4) then
call i_h_j (dav_det(1,1,org_j),dav_det(1,1,org_i),n_int,hij)
call get_s2(dav_det(1,1,org_j),dav_det(1,1,org_i),n_int,s2)
! call i_h_j (sorted_(1,j,2),sorted_(1,i,2),n_int,hij)
! call get_s2(sorted_(1,j,2),sorted_(1,i,2),n_int,s2)
if(.not. wrotten(ii)) then
wrotten(ii) = .true.
idx(ii) = org_i
@ -133,10 +141,8 @@ subroutine davidson_collect(N, idx, vt, st , v0t, s0t)
integer :: i, j, k
!DIR$ IVDEP
do i=1,N
k = idx(i)
!DIR$ IVDEP
do j=1,N_states_diag
v0t(j,k) = v0t(j,k) + vt(j,i)
s0t(j,k) = s0t(j,k) + st(j,i)
@ -415,9 +421,7 @@ subroutine davidson_collector(zmq_to_qp_run_socket, zmq_socket_pull , v0, s0, LD
deallocate(idx,vt,st)
integer :: i,j
!DIR$ IVDEP
do j=1,N_states_diag
!DIR$ IVDEP
do i=1,dav_size
v0(i,j) = v0t(j,i)
s0(i,j) = s0t(j,i)

4
src/Davidson/diagonalization_hs2.irp.f
View File

@ -191,8 +191,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
ASSERT (Nint > 0)
ASSERT (Nint == N_int)
update_dets = 1
! Davidson iterations
! ===================
@ -213,6 +211,8 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
enddo
update_dets = 1
do while (.not.converged)
do k=1,N_st_diag

3
src/Davidson/u0Hu0.irp.f
View File

@ -339,7 +339,8 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_
workload += (shortcut_(j+1,2) - shortcut_(j, 2))**2
end do
end do
istep = 1+ int(workload*target_workload_inv)
! istep = 1+ int(workload*target_workload_inv)
istep = 1
do blockb2=0, istep-1
write(tmp_task,'(3(I9,X),''|'',X)') sh, blockb2, istep
task = task//tmp_task

4
src/Utils/LinearAlgebra.irp.f
View File

@ -152,8 +152,8 @@ subroutine ortho_qr(A,LDA,m,n)
LWORK=2*WORK(1)
deallocate(WORK)
allocate(WORK(LWORK))
call dgeqrf( m, n, A, LDA, TAU, WORK, LWORK, INFO )
call dorgqr(m, n, n, A, LDA, tau, WORK, LWORK, INFO)
call dgeqrf(m, n, A, LDA, TAU, WORK, LWORK, INFO )
call dorgqr(m, n, n, A, LDA, tau, WORK, LWORK, INFO)
deallocate(WORK,jpvt,tau)
end