PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-14 18:13:51 +01: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
if (state_following) then
allocate(overlap(N_st_diag*itermax, N_st_diag*itermax), &
y_tmp(N_st_diag*itermax, N_st_diag*itermax))
allocate(overlap(N_st_diag*itermax, N_st_diag*itermax))
allocate(y_tmp(N_st_diag*itermax, N_st_diag*itermax))
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
overlap = 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_s, s, (/sze,N_st_diag*itermax/))
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
allocate( &
! Large
U(sze,N_st_diag*itermax), &
S_d(sze,N_st_diag), &
!allocate( &
! ! Large
! U(sze,N_st_diag*itermax), &
! S_d(sze,N_st_diag), &
! Small
h(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), &
s_(N_st_diag*itermax,N_st_diag*itermax), &
s_tmp(N_st_diag*itermax,N_st_diag*itermax), &
residual_norm(N_st_diag), &
s2(N_st_diag*itermax), &
y_s(N_st_diag*itermax,N_st_diag*itermax), &
lambda(N_st_diag*itermax))
! ! Small
! h(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), &
! s_(N_st_diag*itermax,N_st_diag*itermax), &
! s_tmp(N_st_diag*itermax,N_st_diag*itermax), &
! residual_norm(N_st_diag), &
! s2(N_st_diag*itermax), &
! y_s(N_st_diag*itermax,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)
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
s_(i,j) = (0.d0,0.d0)
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
@ -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)?
call zgemm('C','N', shift2, shift2, sze, &
(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
! --------------

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.
END_DOC
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
complex*16, allocatable :: u_t(:,:), v_t(:,:), s_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 )
lwork=int(work(1))
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))
call zgeqrf(m, n, A, LDA, tau, work, lwork, info )
deallocate(work)
if (info.ne.0) then
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
stop 2
endif
lwork=-1
allocate(work(1))
call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
lwork=int(work(1))
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))
call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
deallocate(work,tau)
if (info.ne.0) then
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
stop 4
endif
end
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))
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)
if (info.ne.0) then
print*,irp_here,' The ',-info,' argument to zung2r had an illegal value'
stop 2
endif
deallocate(work,tau)
end