PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-07-09 04:43:48 +02:00
Code Releases Activity

Merge pull request #1 from QuantumPackage/features_kpts

Browse Source
This commit is contained in:
Kevin Gasperich 2020-05-07 17:32:21 -05:00 committed by GitHub
commit 3e8404901c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 61 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -879,10 +879,11 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
itertot = 0 itertot = 0
if (state_following) then if (state_following) then
allocate(overlap(N_st_diag*itermax, N_st_diag*itermax), & allocate(overlap(N_st_diag*itermax, N_st_diag*itermax))
y_tmp(N_st_diag*itermax, N_st_diag*itermax)) allocate(y_tmp(N_st_diag*itermax, N_st_diag*itermax))
else else
allocate(overlap(1,1),y_tmp(1,1)) ! avoid 'if' for deallocate allocate(overlap(1,1))
allocate(y_tmp(1,1)) ! avoid 'if' for deallocate
endif endif
overlap = 0.d0 overlap = 0.d0
y_tmp = (0.d0,0.d0) y_tmp = (0.d0,0.d0)
@ -1002,24 +1003,37 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/)) call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/))
call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/)) call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/))
else else
allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax)) !allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax))
allocate(W(sze,N_st_diag*itermax))
allocate(S(sze,N_st_diag*itermax))
endif endif
allocate( & !allocate( &
! Large ! ! Large
U(sze,N_st_diag*itermax), & ! U(sze,N_st_diag*itermax), &
S_d(sze,N_st_diag), & ! S_d(sze,N_st_diag), &
! Small ! ! Small
h(N_st_diag*itermax,N_st_diag*itermax), & ! h(N_st_diag*itermax,N_st_diag*itermax), &
h_p(N_st_diag*itermax,N_st_diag*itermax), & ! h_p(N_st_diag*itermax,N_st_diag*itermax), &
y(N_st_diag*itermax,N_st_diag*itermax), & ! y(N_st_diag*itermax,N_st_diag*itermax), &
s_(N_st_diag*itermax,N_st_diag*itermax), & ! s_(N_st_diag*itermax,N_st_diag*itermax), &
s_tmp(N_st_diag*itermax,N_st_diag*itermax), & ! s_tmp(N_st_diag*itermax,N_st_diag*itermax), &
residual_norm(N_st_diag), & ! residual_norm(N_st_diag), &
s2(N_st_diag*itermax), & ! s2(N_st_diag*itermax), &
y_s(N_st_diag*itermax,N_st_diag*itermax), & ! y_s(N_st_diag*itermax,N_st_diag*itermax), &
lambda(N_st_diag*itermax)) ! lambda(N_st_diag*itermax))
allocate(U(sze,N_st_diag*itermax))
allocate(S_d(sze,N_st_diag))
allocate(h(N_st_diag*itermax,N_st_diag*itermax))
allocate(h_p(N_st_diag*itermax,N_st_diag*itermax))
allocate(y(N_st_diag*itermax,N_st_diag*itermax))
allocate(s_(N_st_diag*itermax,N_st_diag*itermax))
allocate(s_tmp(N_st_diag*itermax,N_st_diag*itermax))
allocate(residual_norm(N_st_diag))
allocate(s2(N_st_diag*itermax))
allocate(y_s(N_st_diag*itermax,N_st_diag*itermax))
allocate(lambda(N_st_diag*itermax))
h = (0.d0,0.d0) h = (0.d0,0.d0)
U = (0.d0,0.d0) U = (0.d0,0.d0)
@ -1162,7 +1176,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
do i=1,shift2 do i=1,shift2
s_(i,j) = (0.d0,0.d0) s_(i,j) = (0.d0,0.d0)
do k=1,sze do k=1,sze
s_(i,j) = s_(i,j) + dconjg(U(k,i)) * cmplx(S(k,j)) s_(i,j) = s_(i,j) + dconjg(U(k,i)) * dcmplx(S(k,j))
enddo enddo
enddo enddo
enddo enddo
@ -1174,7 +1188,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
!todo: why not size(h,1)? !todo: why not size(h,1)?
call zgemm('C','N', shift2, shift2, sze, & call zgemm('C','N', shift2, shift2, sze, &
(1.d0,0.d0), U, size(U,1), W, size(W,1), & (1.d0,0.d0), U, size(U,1), W, size(W,1), &
(0.d0,0.d0), h, size(h_p,1)) (0.d0,0.d0), h, size(h,1))
! Penalty method ! Penalty method
! -------------- ! --------------

4
src/davidson/u0_h_u0.irp.f
View File

@ -797,7 +797,9 @@ subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze)
! istart, iend, ishift, istep are used in ZMQ parallelization. ! istart, iend, ishift, istep are used in ZMQ parallelization.
END_DOC END_DOC
integer, intent(in) :: N_st,sze integer, intent(in) :: N_st,sze
complex*16, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st) complex*16, intent(out) :: v_0(sze,N_st), s_0(sze,N_st)
complex*16, intent(inout) :: u_0(sze,N_st)
!complex*16, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st)
integer :: k integer :: k
complex*16, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) complex*16, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t

24
src/utils/linear_algebra.irp.f
View File

@ -224,18 +224,34 @@ subroutine ortho_qr_complex(A,LDA,m,n)
call zgeqrf( m, n, A, LDA, tau, work, lwork, info ) call zgeqrf( m, n, A, LDA, tau, work, lwork, info )
lwork=int(work(1)) lwork=int(work(1))
deallocate(work) deallocate(work)
if (info.ne.0) then
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
stop 1
endif
allocate(work(lwork)) allocate(work(lwork))
call zgeqrf(m, n, A, LDA, tau, work, lwork, info ) call zgeqrf(m, n, A, LDA, tau, work, lwork, info )
deallocate(work) deallocate(work)
if (info.ne.0) then
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
stop 2
endif
lwork=-1 lwork=-1
allocate(work(1)) allocate(work(1))
call zungqr(m, n, n, A, LDA, tau, work, lwork, info) call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
lwork=int(work(1)) lwork=int(work(1))
deallocate(work) deallocate(work)
if (info.ne.0) then
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
stop 3
endif
allocate(work(lwork)) allocate(work(lwork))
call zungqr(m, n, n, A, LDA, tau, work, lwork, info) call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
deallocate(work,tau) deallocate(work,tau)
if (info.ne.0) then
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
stop 4
endif
end end
subroutine ortho_qr_unblocked_complex(A,LDA,m,n) subroutine ortho_qr_unblocked_complex(A,LDA,m,n)
@ -260,7 +276,15 @@ subroutine ortho_qr_unblocked_complex(A,LDA,m,n)
allocate(tau(n),work(n)) allocate(tau(n),work(n))
call zgeqr2(m,n,A,LDA,tau,work,info) call zgeqr2(m,n,A,LDA,tau,work,info)
if (info.ne.0) then
print*,irp_here,' The ',-info,' argument to zgeqr2 had an illegal value'
stop 1
endif
call zung2r(m,n,n,A,LDA,tau,work,info) call zung2r(m,n,n,A,LDA,tau,work,info)
if (info.ne.0) then
print*,irp_here,' The ',-info,' argument to zung2r had an illegal value'
stop 2
endif
deallocate(work,tau) deallocate(work,tau)
end end